home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / basic / statsfuncs / statsfuncs2.asc < prev   
Encoding:
Text File  |  1999-05-14  |  128.0 KB  |  5,171 lines
  1. ;-----------------------------------------------------------------
  2. v$="$VER: StatsFuncs 2.0 (24.4.1999) James L Boyd "
  3. ;-----------------------------------------------------------------
  4. .Info
  5. ;-----------------------------------------------------------------
  6.  
  7. ; Quick Usage :
  8. ; -------------
  9.  
  10. ; IMPORTANT!!! Put Blitzlibs:Amigalibs.res into the "Compiler
  11. ; Options" window's Resident box before trying any demos!!!
  12.  
  13. ; 1) Each call has a demonstration underneath it.
  14.  
  15. ; 2) Remember, the function/statement names are case-sensitive.
  16. ;                                               --------------
  17. ; 3) Also, a lot of these require you to have the resident
  18. ;    file "blitzlibs:amigalibs.res" present. If you don't know
  19. ;    what this means : Go to the "Compiler" menu, select
  20. ;    "Compiler Options...", and type (without the quotes) :
  21. ;    "blitzlibs:amigalibs.res" in the box underneath the
  22. ;    "Resident" label. That's it.
  23.  
  24. ; 4) Some of them require a currently used screen, or window.
  25.  
  26. ; 5) I've grouped them according to the context I think they're
  27. ;    most likely to be used in. You will probably find some that
  28. ;    you think should be in a different section than they're
  29. ;    currently in, but we could argue about that all day ;)
  30.  
  31. ;    So don't bother telling me :D
  32.  
  33. ;-----------------------------------------------------------------
  34.  
  35. ; Testing the routines :
  36. ; ----------------------
  37.  
  38. ; You can test each function or statement by uncommenting the
  39. ; function/statement demo you want to try, ONE AT A TIME (you
  40. ; MUST re-comment each one before testing another! - unless
  41. ; you know what you're doing).
  42.  
  43. ;-----------------------------------------------------------------
  44.  
  45. ; General Information :
  46. ; ---------------------
  47.  
  48. ; This set of statements and functions for Blitz Basic 2
  49. ; was compiled by James L Boyd, though many of the routines
  50. ; were supplied by others.
  51.  
  52. ; Any comments, contributions or bug-fixes to :
  53.  
  54. ; jamesboyd@all-hail.freeserve.co.uk
  55.  
  56. ;-----------------------------------------------------------------
  57.  
  58. ; More information :
  59. ; ------------------
  60.  
  61. ; These routines were written for a few reasons :
  62.  
  63. ; 1) They often result in savings on executable file size,
  64. ;    sometimes quite significantly (not always though ;)
  65.  
  66. ; 2) Some of these routines are not available in any
  67. ;    Blitz or 3rd party libraries.
  68.  
  69. ; 3) Some of the routines are bugfixed versions of
  70. ;    existing Blitz/3rd party library routines.
  71.  
  72. ; 4) You don't have to use them as statements or functions,
  73. ;    but can just strip out the code you need, or just
  74. ;    use them as a reference for how to do certain things.
  75.  
  76. ; 5) Some of them, of course, are just plain useless :)
  77.  
  78. ;-----------------------------------------------------------------
  79.  
  80. ; Beginners (or "I have no idea what all this is") :
  81. ; --------------------------------------------------
  82.  
  83. ; NOTE - none of these example routines exist - I've just
  84. ; made 'em up on the spot :)
  85.  
  86. ; Statements - How to call 'em
  87. ; ----------------------------
  88.  
  89. ; Statements are commands that don't return
  90. ; any values.
  91.  
  92. ; You call a statement just by typing the
  93. ; name of the statement and giving any parameters
  94. ; it needs :
  95.  
  96. ; eg. HelloText {} might print "Hello" in a window.
  97.  
  98. ; ShowTime {50,50} might put up a requester at
  99. ; co-ordinates x=50,y=50 with the time in it.
  100.  
  101. ; Easy :)
  102.  
  103. ; Functions - How to call 'em
  104. ; ---------------------------
  105.  
  106. ; Functions are basically commands which return values.
  107.  
  108. ; Some functions perform actions, like opening a requester
  109. ; or drawing a graphic in a window :
  110.  
  111. ; eg. result.b=MadeUpRequest {"Hello"} might put up
  112. ; a requester with the body text "Hello" and the title
  113. ; and gadget text already built into the function. This
  114. ; function would probably return the value of the gadget
  115. ; that was hit.
  116.  
  117. ; Others just return a value depending on what you've
  118. ; supplied them with :
  119.  
  120. ; eg. new$=AddHello {"Mr Bond"}
  121.  
  122. ; This might return "Hello Mr Bond" in new$.
  123.  
  124. ; Functions always return a value, so you must
  125. ; have a variable to receive them, even if it's
  126. ; just a dummy variable that you do nothing with :
  127.  
  128. ; eg. dummy.l=DoesSomething {"I do nothing"}
  129.  
  130. ; As for what type of variable to use, have a
  131. ; look at the function itself - if it says
  132. ; Function.b it returns a byte, Function.l
  133. ; would return a long, Function$ or Function.s
  134. ; would return a string, etc, so you just use that
  135. ; type of variable. If it just says Function, it'll
  136. ; be a "quick" type (usually the default type).
  137.  
  138. ; You can also use functions in the same way that you
  139. ; use any other variable. For example, if a function
  140. ; returns a string :
  141.  
  142. ; Request "Test","The time is :"+GetTime {},"OK"
  143.  
  144. ; Because functions act just like variables, you
  145. ; can Print any function's result :
  146.  
  147. ; eg. Print ShowSomething {"Hello"} might put
  148. ; up a requester which says "Hello" and then when
  149. ; you click on the gadget, it prints the result
  150. ; into the current window/CLI.
  151.  
  152. ; And if you didn't understand that, just uncomment
  153. ; some of the routines (one at a time - re-comment
  154. ; each on after testing it!). Try altering the
  155. ; values given and see what happens - you'll soon
  156. ; get the hang of it :)
  157.  
  158. ;-----------------------------------------------------------------
  159.  
  160. ; DISCLAIMER and stuff :
  161. ; ----------------------
  162.  
  163. ; I've added as many credits as possible. If you wrote
  164. ; any of these routines (or know who did), let me know!
  165.  
  166. ; Also, I should point out that some have been modified
  167. ; to suit the overall format of this file.
  168.  
  169. ; If anyone recognises any of their own routines here,
  170. ; let me know, and I'll put the appropriate credit into
  171. ; this file (or remove the function if it's a problem) !
  172.  
  173. ; On with the show...
  174.  
  175. ;-----------------------------------------------------------------
  176. .
  177. .Screens
  178.  
  179. ;-----------------------------------------------------------------
  180.  
  181. ; This section deals with routines to do with screen information
  182. ; and usage, like finding the screen dimensions and so on.
  183.  
  184. ;-----------------------------------------------------------------
  185.  
  186. ; Current routines :
  187.  
  188. ; NewWBDepth      { coloursflag }
  189. ; TitleBarHeight  { screen }
  190. ; ScreenMouseX    {}
  191. ; ScreenMouseY    {}
  192. ; IsScreenActive  { screen }
  193. ; ScreenH         { screen }
  194. ; ScreenW         { screen }
  195.  
  196. ;-----------------------------------------------------------------
  197.  
  198. ; Function NewWBDepth { coloursflag }
  199.  
  200. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  201.  
  202. ; GetBitMapAttr_() fix for gfx cards by Paul Burkey - burkey@bigfoot.com
  203.  
  204. ; Returns depth of user's Workbench screen (or colours
  205. ; if you supply a non-zero value (eg. 1!) for coloursflag.
  206.  
  207. ; Like Blitz's WBDepth, but returns correct value on
  208. ; graphics card Workbenches too, whereas WBDepth only
  209. ; returns a maximum of 8!
  210.  
  211. ; Replaces WBColours {} function from older StatsFuncs...
  212.  
  213. Function.l NewWBDepth {coloursflag.b}
  214.  
  215.   *sc.Screen=LockPubScreen_ ("Workbench")
  216.  
  217.   If *sc
  218.     deep.l=GetBitMapAttr_(*sc\_RastPort\_BitMap,#BMA_DEPTH)
  219.  
  220. ;    deep.l=GetBitMapAttr_(*sc\RastPort\BitMap,#BMA_DEPTH)
  221.  
  222. ; NOTE - if you get "offset not found", try uncommenting the
  223. ; above line and commenting out the original...different versions
  224. ; of amigalibs.res have different offset names...
  225.  
  226.     UnlockPubScreen_ "Workbench",*sc
  227.   EndIf
  228.  
  229.   If coloursflag
  230.     Function Return 2^deep  ; send back colours
  231.   Else Function Return deep ; send back depth
  232.   EndIf
  233.  
  234. End Function
  235.  
  236. ; demo :
  237.  
  238. ;NPrint NewWBDepth {0} ; change 0 to -1 (actually, any byte-range value)
  239. ;                      ; to get it to return colours instead of depth
  240. ;End
  241.  
  242. ;-----------------------------------------------------------------
  243.  
  244. ; Function : TitleBarHeight { screen }
  245.  
  246. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  247.  
  248. ; Returns the height of the title bar of the specified
  249. ; screen, or false if the screen doesn't exist!
  250.  
  251. ; The title-bar height for the screen is ALWAYS the same
  252. ; as that of any windows open on the screen, so you can use
  253. ; this to get some info before opening a window.
  254.  
  255. Function.w TitleBarHeight{scr.b}
  256.  
  257. If Peek.l(Addr Screen(scr))
  258.   *scr.Screen=Peek.l(Addr Screen(scr)) ; get screen info...
  259.   Function Return *scr\BarHeight+1
  260. Else Function Return 0
  261. EndIf
  262.  
  263. End Function
  264.  
  265. ; demo :
  266.  
  267. ; FindScreen 0
  268. ; Print TitleBarHeight{0}
  269. ; MouseWait:End
  270.  
  271. ;-----------------------------------------------------------------
  272.  
  273. ; Function : ScreenMouseX {}
  274.  
  275. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  276.  
  277. ; Returns X position of mouse relative to top-left of
  278. ; CURRENTLY USED screen (same as SMouseX, but smaller exec
  279. ; size will result).
  280.  
  281. Function ScreenMouseX {}
  282. *scr.Screen=Peek.l(Addr Screen(Used Screen))
  283.   If *scr
  284.     Function Return *scr\_MouseX
  285.   Else Function Return 0
  286.   EndIf
  287. End Function
  288.  
  289. ; demo : see demo for ScreenMouseY{}
  290.  
  291. ;-----------------------------------------------------------------
  292.  
  293. ; Function : ScreenMouseY {}
  294.  
  295. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  296.  
  297. ; Returns Y position of mouse relative to top-left of
  298. ; CURRENTLY USED screen (same as SMouseY, but smaller exec
  299. ; size will result).
  300.  
  301. Function ScreenMouseY {}
  302.  
  303. *scr.Screen=Peek.l(Addr Screen(Used Screen))
  304.  
  305. If *scr
  306. Function Return *scr\_MouseY
  307. Else Function Return 0
  308. EndIf
  309.  
  310. End Function
  311.  
  312. ; demo :
  313.  
  314. ;; NOTE : Uses ScreenMouseX {} too.
  315.  
  316. ; FindScreen 0
  317. ; Window 0,50,50,500,100,$140f,"",1,2
  318.  
  319. ; While Event<>$200
  320. ;   VWait
  321. ;   WTitle "X : "+Str$(ScreenMouseX{})+" / Y : "+Str$(ScreenMouseY{})
  322. ; Wend
  323.  
  324. ; End
  325.  
  326. ;-----------------------------------------------------------------
  327.  
  328. ; Function : IsScreenActive { screen number }
  329.  
  330. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  331.  
  332. ; Returns True (-1) if screen is active, False (0) if not.
  333. ; NOTE : Active DOES NOT necessarily mean the frontmost screen!
  334.  
  335. Function IsScreenActive {scr.b}
  336.  
  337.   If Peek.l(Addr Screen(scr)) = ActiveScreen
  338.     Function Return -1
  339.   Else Function Return 0
  340.   EndIf
  341.  
  342. End Function
  343.  
  344. ; demo :
  345.  
  346. ; FindScreen 0
  347.  
  348. ; If IsScreenActive {0}
  349. ;   Request "","IsScreenActive returned True...","OK"
  350. ; Else Request "","IsScreenActive returned False...","OK"
  351. ; EndIf
  352.  
  353. ; End
  354.  
  355. ;-----------------------------------------------------------------
  356.  
  357. ; Function : ScreenH { screen number }
  358.  
  359. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  360.  
  361. ; Replacement for ScreenHeight, saving around 7k from exec size.
  362.  
  363. ; Returns the height of the specified screen.
  364. ; Use ScreenH {Used Screen} if that's convenient to you :)
  365.  
  366. Function ScreenH {sc.b}
  367.  
  368. *SC.Screen=Peek.l(Addr Screen(sc))
  369.  
  370. If *SC
  371.   Function Return *SC\Height
  372. Else Function Return 0
  373. EndIf
  374.  
  375. End Function
  376.  
  377. ; demo :
  378.  
  379. ; FindScreen 0,"Workbench Screen"
  380.  
  381. ; Request "","Your Workbench screen is "+Str$(ScreenH {0})+" pixels high.","Correct!"
  382. ; End
  383.  
  384. ;-----------------------------------------------------------------
  385.  
  386. ; Function : ScreenW { screen number }
  387.  
  388. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  389.  
  390. ; Replacement for ScreenWidth, saving around 7k from exec size.
  391.  
  392. ; Returns the width of the specified screen.
  393. ; Use ScreenW {Used Screen} if that's convenient to you :)
  394.  
  395. Function ScreenW {sc.b}
  396.  
  397. *SC.Screen=Peek.l(Addr Screen(sc))
  398.  
  399. If *SC
  400.   Function Return *SC\Width
  401. Else Function Return 0
  402. EndIf
  403.  
  404. End Function
  405.  
  406. ; demo :
  407.  
  408. ; FindScreen 0,"Workbench Screen"
  409.  
  410. ; Request "","Your Workbench screen is "+Str$(ScreenW {0})+" pixels wide.","Correct!"
  411. ; End
  412.  
  413. ;-----------------------------------------------------------------
  414. .
  415. .Windows
  416.  
  417. ;-----------------------------------------------------------------
  418.  
  419. ; This section deals with routines to do with window information
  420. ; and usage, like finding the window dimensions, drawing in
  421. ; windows, fonts in windows, etc.
  422.  
  423. ;-----------------------------------------------------------------
  424.  
  425. ; Current routines :
  426.  
  427. ; FlashText         { window, x, y, no , text, speed }
  428. ; Draw3dBox         { x, y, width, height, style }
  429. ; WOutline          { x1, y1, x2, y2, hilite, shadow }
  430. ; WBevel            { x, y, x2, y2, hilite, shadow }
  431. ; CenterString      { text, window }
  432. ; PixelLen          { text }
  433. ; CentreWindowX     { width of window }
  434. ; CentreWindowY     { height of window }
  435. ; WindowOpened      { window }
  436. ; WindowFillScreen  { window number, flags, title }
  437. ; WindowW           { window }
  438. ; WindowH           { window }
  439. ; WindowFlags       { window }
  440. ; WinMouseX         {}
  441. ; WinMouseY         {}
  442. ; LoadScreenFont    { font number }
  443. ; WBWinAddr         {}
  444. ; BFWindow          { window, left, top, right, bottom, pen }
  445. ; WindowTitle       { window, window title, screen title }
  446. ; WinCls            { colour }
  447. ; CleanBorder       { window number }
  448. ; LockWindow        { window }
  449. ; UnLockWindow      { window, lock }
  450. ; HidePointer       { window }
  451. ; ShowPointer       { window }
  452. ; WPrint            { x, y, text }
  453. ; WFBox             { window, left, right, top, bottom }
  454.  
  455. ;-----------------------------------------------------------------
  456.  
  457. ; Statement : FlashText { window, x, y, no , text, speed }
  458.  
  459. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  460.  
  461. ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk
  462. ; Now optimised for speed and executable size :)
  463.  
  464. ; Shows flashing text in a window.
  465.  
  466. ; x is the left position, y is the top position, no is the
  467. ; number of times to flash, speed is the DELAY in ticks.
  468.  
  469. ; note that this uses colours 1 and 0 - you'll have to
  470. ; alter it for anything else...can't add it as parameters
  471. ; due to Blitz's 6-parameter limit in statements & functions :(
  472.  
  473. Statement FlashText {win.b,x.w,y.w,no.w,a$,speed.b}
  474.   rp.l=RastPort(0)
  475.   strlen=Len(a$)
  476.   For a=1 To no*2-1
  477.     color=1-color
  478.     SetAPen_ rp,color
  479.     Move_ rp,x,y
  480.     Text_ rp,a$,strlen
  481.     Delay_ speed
  482.   Next a
  483.   SetAPen_ rp,1
  484.   Move_ rp,x,y
  485.   Text_ rp,a$,strlen
  486. End Statement
  487.  
  488. ; demo :
  489.  
  490. ; FindScreen 0
  491. ; Window 0,0,0,640,200,$140f,"FlashText Demo",1,2
  492. ; FlashText{0,100,100,5,"Hello,I'm flashing (5 times)!",10}
  493.  
  494. ; End
  495.  
  496. ;-----------------------------------------------------------------
  497.  
  498. ; Statement : Draw3dBox { x, y, width, height, style }
  499.  
  500. ; Draws a 3d box in a window.
  501. ; Note that you do need a window to use this!
  502. ; See demo for more.
  503.  
  504. ; **** UPDATED by Nick Clover ****
  505. ; Optimised for speed and executable size :)
  506.  
  507. Statement Draw3dBox {ax,ay,Width.l,Height.l,way.b}
  508.   ax2.l = ax+Width-1:ay2.l = ay+Height-1
  509.   SHARED rp.l
  510.   SetAPen_ rp,2-way:Move_ rp,ax2,ay:Draw_ rp,ax,ay:Draw_ rp,ax,ay2
  511.   If way=0
  512.     SetAPen_ rp,1:Move_ rp,ax+1,ay2  :Draw_ rp,ax2,ay2    :Draw_ rp,ax2,ay
  513.     SetAPen_ rp,3:Move_ rp,ax+1,ay2-1:Draw_ rp,ax2-1,ay2-1:Draw_ rp,ax2-1,ay+1
  514.   Else
  515.     SetAPen_ rp,3:Move_ rp,ax2-1,ay+1:Draw_ rp,ax+1,ay+1:Draw_ rp,ax+1,ay2-1
  516.     SetAPen_ rp,2:Move_ rp,ax+1,ay2  :Draw_ rp,ax2,ay2  :Draw_ rp,ax2,ay
  517.   EndIf
  518. End Statement
  519.  
  520. ; demo :
  521.  
  522. ; FindScreen 0
  523. ; Window 0,0,0,640,200,$140f,"Click to close...",1,2
  524. ; rp.l=RastPort(0)
  525. ; Draw3dBox{10,10,350,150,0} ; try replacing the 0 with 1 for
  526. ;                              an inverse Box...
  527. ; MouseWait:End
  528.  
  529. ;-----------------------------------------------------------------
  530.  
  531. ; Statement : WOutline { x1, y1, x2, y2, hilite, shadow }
  532.  
  533. ; Author : Mark Tiffany
  534.  
  535. ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk
  536. ; Now updated for speed and executable size.
  537.  
  538. ; Draws a nice bounding box in a window...useful for fancy
  539. ; borders, gadget boxes, etc.
  540.  
  541. ;IMPORTANT NOTE : You must make the call "rp.l=RastPort (window)"
  542. ;                 before calling this function now - this
  543. ;                 is due to Blitz's 6-parameter limit
  544. ;                 in statements :(
  545.  
  546. Statement WOutline {x1.w,y1.w,x2.w,y2.w,hilite.w,shadow.w}
  547.   SHARED rp.l
  548.   SetAPen_ rp,hilite
  549.   Move_ rp,x1,y1:Draw_ rp,x2-1,y1:Draw_ rp,x2-1,y2-1:Draw_ rp,x1,y2-1:Draw_ rp,x1,y1
  550.   SetAPen_ rp,shadow
  551.   Move_ rp,x1+1,y1+1:Draw_ rp,x2,y1+1:Draw_ rp,x2,y2:Draw_ rp,x1+1,y2:Draw_ rp,x1+1,y1+1
  552. End Statement
  553.  
  554. ; demo :
  555.  
  556. ; FindScreen 0
  557. ; Window 0,0,0,640,200,$40f,"",1,2
  558.  
  559. ; rp.l=RastPort(0)
  560.  
  561. ;; ^^^ IMPORTANT!!! MUST call this before WOutline!!!
  562.  
  563. ; WOutline{60,60,170,150,1,2} ; try swapping the 1 and 2 over
  564.                               ; for an inverse box :)
  565. ; MouseWait:End
  566.  
  567. ;-----------------------------------------------------------------
  568.  
  569. ; Statement : WBevel { x, y, x2, y2, hilite, shadow }
  570.  
  571. ; Author : Mark Tiffany
  572.  
  573. ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk
  574. ; Now updated for speed and executable size.
  575.  
  576. ; Draws a nice bevel box in a window...useful for fancy
  577. ; borders, gadget boxes, etc.
  578.  
  579. ;IMPORTANT NOTE : You must make the call "rp.l=RastPort (window)"
  580. ;                 before calling this function now - this
  581. ;                 is due to Blitz's 6-parameter limit
  582. ;                 in statements :(
  583.  
  584. Statement WBevel{x1.w,y1.w,x2.w,y2.w,hilite.w,shadow.w}
  585.   SHARED rp.l
  586.   SetAPen_ rp,shadow:Move_ rp,x1,y1:Draw_ rp,x2-1,y1:Draw_ rp,x2-1,y2-1:Draw_ rp,x1,y2-1:Draw_ rp,x1,y1
  587.   SetAPen_ rp,hilite:Move_ rp,x1+1,y1+1:Draw_ rp,x2,y1+1:Draw_ rp,x2,y2:Draw_ rp,x1+1,y2:Draw_ rp,x1+1,y1+1
  588.   SetAPen_ rp,shadow:Move_ rp,x1+2,y2-2:Draw_ rp,x1+2,y1+2:Draw_ rp,x2-2,y1+2
  589.   SetAPen_ rp,hilite:Move_ rp,x2-2,y1+2:Draw_ rp,x2-2,y2-2:Draw_ rp,x1+2,y2-2
  590.   SetAPen_ rp,shadow:WritePixel_ rp,x2-1,y1+1:WritePixel_ rp,x1+1,y2-1
  591. End Statement
  592.  
  593. ; demo :
  594.  
  595. ; FindScreen 0
  596. ; Window 0,0,0,200,80,$140f,"",1,2
  597.  
  598. ; rp.l=RastPort(0); IMPORTANT!!! MUST call this first now!!!
  599.  
  600. ; WBevel{10,10,100,50,1,2} ; try swapping the 1 and 2 over
  601.                            ; for an inverse bevel :)
  602.  
  603. ; MouseWait:End
  604.  
  605. ;-----------------------------------------------------------------
  606.  
  607. ; Function : CenterString { text, window }
  608.  
  609. ; Returns cursor x position to use for centering a string
  610. ; in a given window, using that window's current font
  611.  
  612. ; Returns True (-1) if the string won't fit.
  613.  
  614. Function.w CenterString{text$,windownum.w}
  615.   Use Window (windownum)
  616.   *rp.l=RastPort (windownum)              ;find the window's rastport
  617.   strln.w=Len(text$)                      ;we need the character count too
  618.   pixels.w=TextLength_ (*rp,&text$,strln) ;pixel width of the string
  619.   winspace.w=InnerWidth                   ;available printing width
  620.   If pixels<winspace                      ;there is enough room
  621.     startX.w=winspace/2 -pixels/2         ;starting position
  622.     Function Return startX                ;and send it back
  623.   Else                                    ;OH, NO!  not enough room!
  624.     Function Return -1                    ;tell 'em the bad news
  625.   EndIf
  626. End Function
  627.  
  628. ; demo
  629.  
  630. ; FindScreen 0
  631. ; Window 0,0,0,640,200,$140f,"CenterString test",1,2
  632.  
  633. ; ; *** Try making the window 100 wide ***
  634.  
  635. ; test$="Hello, I'm a very, very long text string. I really am..."
  636.  
  637. ; x.w=CenterString {test$,0}
  638.  
  639. ; ; if x=-1 then the string won't fit :
  640.  
  641. ; If x>-1
  642. ;   WLocate x,WTopOff:Print test$
  643. ; Else Request "","String won't fit!","OK"
  644. ; EndIf
  645.  
  646. ; MouseWait:End
  647.  
  648. ;-----------------------------------------------------------------
  649.  
  650. ; Function : PixelLen { text }
  651.  
  652. ; Returns the number of pixels in width required to print
  653. ; the requested string.
  654.  
  655. Function.w PixelLen{a$}
  656.   rp.l=RastPort(0) ; The rastport of the used window.
  657.   Function Return TextLength_(rp,&a$,Len(a$))
  658. End Function
  659.  
  660. ; demo :
  661.  
  662. ; FindScreen 0
  663.  
  664. ; If Window (0,0,0,640,200,$40f,"",1,2)=0 Then Request "","Window too wide!","END":End
  665.  
  666. ;; if the above function fails on your system, just use :
  667. ;; Window 0,0,0,640,200,$40f,"",1,2           ...instead!
  668.  
  669. ;   a$="Some Pixels"    ; use this text
  670. ;   pix.w=PixelLen{a$}  ; find pixel width of text
  671.  
  672. ;; print information :
  673.  
  674. ;   NPrint ""
  675. ;   NPrint "PixelLen {"+Chr$(34)+a$+Chr$(34)+"} returns a value of : ",pix
  676. ;   NPrint ""
  677. ;   Print "     ":WJam 4:NPrint a$
  678. ;   NPrint ""
  679. ;   WJam 0:NPrint "So "+Chr$(34)+a$+Chr$(34)+" is ",pix," pixels wide in this WindowFont."
  680. ;   NPrint "":NPrint "-----------------------------------------------------------------"
  681.  
  682. ; demo 2 :
  683.  
  684. ; a$="Lots and lots and lots and lots and lots and lots and lots and lots and lots and lots of text"
  685.  
  686. ;; try taking out a couple of "and lots" to make it fit!
  687.  
  688. ; NPrint "":NPrint a$
  689.  
  690. ; If PixelLen {a$}>InnerWidth
  691. ;   NPrint "":NPrint "The string above is too wide!"
  692. ;   Else NPrint "":NPrint "Yep,that string fits!"
  693. ; EndIf
  694.  
  695. ; Repeat
  696. ; VWait 5
  697. ; Until Event=$200
  698. ; End
  699.  
  700. ;-----------------------------------------------------------------
  701.  
  702. ; Function : CentreWindowX { width of window }
  703.  
  704. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  705.  
  706. ; Returns x position for window of width "width.w".
  707.  
  708. ; Use it with CentreWindowY {} to centre a window
  709. ; both ways in the CURRENTLY USED screen.
  710.  
  711. Function.w CentreWindowX {width.w}
  712.   x.w=(ScreenWidth/2)-(width/2)
  713. Function Return x
  714. End Function
  715.  
  716. ; demo :
  717.  
  718. ; See demo for CentreWindowY {} !
  719.  
  720. ;-----------------------------------------------------------------
  721.  
  722. ; Function : CentreWindowY { height of window }
  723.  
  724. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  725.  
  726. ; Returns y position for window of height "height.w".
  727.  
  728. ; Use it with CentreWindowX {} to centre a window
  729. ; both ways in the CURRENTLY USED screen.
  730.  
  731. Function.w CentreWindowY {height.w}
  732.   y.w=(ScreenHeight/2)-(height/2)
  733. Function Return y
  734. End Function
  735.  
  736. ; demo :
  737.  
  738. ; FindScreen 0
  739.  
  740. ; w=400:h=180
  741. ; Window 0,CentreWindowX {w},CentreWindowY {h},w,h,$140f,"I'm in the middle!",1,2
  742. ; MouseWait:End
  743.  
  744. ;-----------------------------------------------------------------
  745.  
  746. ; Function : WindowOpened { window }
  747.  
  748. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  749.  
  750. ; Although it's possible to do this :
  751.  
  752. ;   If Window (0,0,0,640,200,$140f,"",1,2)=0 Then End
  753.  
  754. ; That apparently doesn't work on some people's setups,
  755. ; hence this function...returns False (0) if the window isn't
  756. ; open.
  757.  
  758. Function WindowOpened {win.b}
  759.   If Peek.l(Addr Window(win))
  760.     Function Return -1
  761.   Else Function Return 0
  762.   EndIf
  763. End Function
  764.  
  765. ; demo :
  766.  
  767. ; Screen 0,10
  768. ; Window 0,0,0,641,200,$140f,"",1,2
  769.  
  770. ; If WindowOpened {0}=0 Then Request "","Failed to open window!","Abort!":End
  771.  
  772. ; MouseWait:End
  773.  
  774. ;-----------------------------------------------------------------
  775.  
  776. ; Function : WindowFillScreen { window number, flags, title }
  777.  
  778. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  779.  
  780. ; A basic function to open a full-screen window, just below the
  781. ; title bar, on the CURRENTLY USED screen - should work for
  782. ; ANY screen/font sizes though.
  783.  
  784. ; You may want to edit parts of the function to suit your
  785. ; program, eg DPen, BPen, GadgetList and BitMap parameters
  786. ; aren't supplied to this function.
  787.  
  788. Function WindowFillScreen {win.b,flags.l,title$}
  789.  
  790. *sc.Screen=Peek.l(Addr Screen(Used Screen))
  791.  
  792. If *sc
  793.   If Peek.l(Addr Window(win))
  794.     Function Return 0
  795.   Else Window win,0,*sc.Screen\BarHeight+1,*sc.Screen\Width,*sc.Screen\Height-(*sc.Screen\BarHeight+1),flags,title$,1,2
  796.     If Peek.l(Addr Window(win))=0
  797.       Function Return 0
  798.     Else Function Return -1
  799.     EndIf
  800.   EndIf
  801. Else Function Return 0
  802. EndIf
  803.  
  804. End Function
  805.  
  806. ; demo :
  807.  
  808. ; WbToScreen 0
  809. ;; Screen 0,28 ; uncomment to test on another screen...
  810.  
  811. ; If WindowFillScreen {0,$140f,"Hello"}=0
  812. ;   Request "","Failed to open window!","OK":End
  813. ; EndIf
  814.  
  815. ; Request "","Ta-daaa!||A nice full-screen window!","Amazing..."
  816. ; End
  817.  
  818. ;-----------------------------------------------------------------
  819.  
  820. ; Function : WindowW { window }
  821.  
  822. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  823.  
  824. ; Returns width of specified window.
  825.  
  826. Function WindowW {win.b}
  827.  
  828. *win.Window=Peek.l(Addr Window(win))
  829.  
  830. If *win
  831.   Function Return *win\Width
  832. Else Function Return 0
  833. EndIf
  834.  
  835. End Function
  836.  
  837. ; demo :
  838.  
  839. ; FindScreen 0
  840. ; Window 0,0,0,640,200,$20140f,"",1,2
  841.  
  842. ; NPrint WindowW {0}
  843. ; MouseWait:End
  844.  
  845. ;-----------------------------------------------------------------
  846.  
  847. ; Function : WindowH { window }
  848.  
  849. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  850.  
  851. ; Returns height of specified window.
  852.  
  853. Function WindowH {win.b}
  854.  
  855. *win.Window=Peek.l(Addr Window(win))
  856.  
  857. If *win
  858.   Function Return *win\Height
  859. Else Function Return 0
  860. EndIf
  861.  
  862. End Function
  863.  
  864. ; demo :
  865.  
  866. ; FindScreen 0
  867. ; Window 0,0,0,640,200,$20140f,"",1,2
  868.  
  869. ; NPrint WindowH {0}
  870. ; MouseWait:End
  871.  
  872. ;-----------------------------------------------------------------
  873.  
  874. ; Function : WindowFlags { window }
  875.  
  876. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  877.  
  878. ; Returns a value containing the window's flag settings.
  879.  
  880. ; Use "If WindowFlags {window} AND *flag*" to check for
  881. ; a particular flag, eg. to check window 0 has a drag bar,
  882. ; use "If WindowFlags {0} AND $2 Then BeepScreen 0", etc.
  883.  
  884. ; The flags are listed on page 177 of the Blitz Basic 2.1
  885. ; manual (or press Right Amiga + HELP with the cursor on the
  886. ; Window command).
  887.  
  888. Function.l WindowFlags {w.b}
  889.  
  890.   *win.Window=Peek.l(Addr Window(w))
  891.  
  892.   If *win
  893.     Function Return *win\Flags
  894.   Else Function Return 0
  895.   EndIf
  896.  
  897. End Function
  898.  
  899. ; demo :
  900.  
  901. ; FindScreen 0
  902. ; Window 0,0,0,640,200,$140f,"",1,2
  903.  
  904. ; If WindowFlags {0} AND $2 Then BeepScreen 0 ; check for drag bar
  905.  
  906. ; Request "","Window's flag settings :||$"+Hex$(WindowFlags {0}),"OK"
  907. ; End
  908.  
  909. ;-----------------------------------------------------------------
  910.  
  911. ; Function : WinMouseX {}
  912.  
  913. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  914.  
  915. ; Returns X position of mouse relative to top-left of
  916. ; CURRENTLY USED window (same as WMouseX, but smaller exec
  917. ; size will result).
  918.  
  919. Function.w WinMouseX {}
  920. *win.Window=Peek.l(Addr Window(Used Window))
  921.   If *win
  922.     Function Return *win\_MouseX
  923.   Else Function Return 0
  924.   EndIf
  925. End Function
  926.  
  927. ; demo : see demo for WinMouseY{}
  928.  
  929. ;-----------------------------------------------------------------
  930.  
  931. ; Function : WinMouseY {}
  932.  
  933. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  934.  
  935. ; Returns Y position of mouse relative to top-left of
  936. ; CURRENTLY USED window (same as WMouseY, but smaller exec
  937. ; size will result).
  938.  
  939. Function.w WinMouseY {}
  940. *win.Window=Peek.l(Addr Window(Used Window))
  941.   If *win
  942.     Function Return *win\_MouseY
  943.   Else Function Return 0
  944.   EndIf
  945. End Function
  946.  
  947. ; demo :
  948.  
  949. ; FindScreen 0
  950. ; Window 0,0,0,640,200,$140f,"",1,2
  951.  
  952. ; Repeat
  953. ;   VWait
  954. ;   WTitle "X : "+Str$(WinMouseX {})+" / Y : "+Str$(WinMouseY {})
  955. ; Until Event=$200
  956.  
  957. ; End
  958.  
  959. ;-----------------------------------------------------------------
  960.  
  961. ; Function : LoadScreenFont { font number }
  962.  
  963. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  964.  
  965. ; Finds the font of the used screen and loads it into
  966. ; the Blitz font object you specify.
  967.  
  968. ; Returns a string containing all of the info, which you can
  969. ; parse in your own way if needed ;)
  970.  
  971. ; If it fails to get a screen (ie you haven't created/taken over
  972. ; one!) or find the font (shouldn't happen!), it returns ""
  973.  
  974. ; NOTE - to use the font in a window, you MUST call the Blitz
  975. ; function WindowFont <window number> afterwards for whichever
  976. ; window you want to use the font in (the window must be open!).
  977.  
  978. Function$ LoadScreenFont {f.w}
  979.  
  980.   *scr.Screen=Peek.l(Addr Screen(Used Screen))
  981.     If *scr=0 Then Function Return ""
  982.  
  983.   *scfont.TextAttr=*scr.Screen\Font
  984.     If *scfont=0 Then Function Return ""
  985.  
  986. ; In AmigaDOS we trust :
  987.   fheight.b=(*scfont.TextAttr\ta_YSize)
  988.   fname$=Peek$(*scfont.TextAttr\ta_Name)
  989.  
  990. LoadFont f,fname$,fheight:Function Return Str$(f)+":"+fname$+":"+Str$(fheight)
  991. End Function
  992.  
  993. ; demo :
  994.  
  995. ; FindScreen 0
  996.  
  997. ; Window 0,0,0,640,150,$20140e,"",1,2
  998.  
  999. ;; NOTE - should really check for LoadScreenFont {} returning
  1000. ;; an empty string here ( "" ) :
  1001.  
  1002. ; NPrint ""
  1003. ; NPrint "LoadScreenFont {0} returns : ",Chr$(34),LoadScreenFont {0},Chr$(34)
  1004. ; NPrint "[ Format : ",Chr$(34),"Font number:Font name:Font height",Chr$(34)," ]"
  1005.  
  1006. ; NPrint ""
  1007. ; NPrint "Still printed using system default font..."
  1008. ; NPrint ""
  1009. ; NPrint "[ - Calling WindowFont! - ]"
  1010.  
  1011. ; WindowFont 0
  1012.  
  1013. ; NPrint ""
  1014. ; NPrint "There - printed using screen font - click mouse to end..."
  1015.  
  1016. ; MouseWait:End
  1017.  
  1018. ;-----------------------------------------------------------------
  1019.  
  1020. ; Function : WBWinAddr {}
  1021.  
  1022. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1023.  
  1024. ; Returns a memory pointer to the Workbench window.
  1025.  
  1026. ; Handy for some OS/3rd party library functions,
  1027. ; (eg requesters).
  1028.  
  1029. ; W A R N I N G ! ! !
  1030.  
  1031. ; DO NOT USE YET!!!
  1032.  
  1033. ; Found out that it returns the first window belonging
  1034. ; to Workbench (may be a directory window!), not always
  1035. ; the actual Workbench window... :(
  1036.  
  1037. Function.l WBWinAddr {}
  1038.  
  1039.   wb$="Workbench"
  1040.   *scr.Screen=LockPubScreen_(&wb$)
  1041.   If *scr
  1042.     *win.Window = *scr\FirstWindow
  1043.     While *win
  1044.       If *win\Flags & #WFLG_WBENCHWINDOW
  1045.         If *win\Title=0
  1046.           Goto poppit
  1047.         EndIf
  1048.       EndIf
  1049.       *win = *win\NextWindow
  1050.     Wend
  1051.   Function Return 0 ; didn't get it!
  1052.  
  1053.   poppit
  1054.   Function Return *win
  1055.  
  1056.   Else Function Return 0
  1057.   EndIf
  1058.  
  1059. End Function
  1060.  
  1061. ; demo :
  1062.  
  1063. ;; NOTE - this demo isn't much use!
  1064.  
  1065. ; *win.Window=WBWinAddr {}
  1066. ; NPrint "Address of WB window : $",Hex$(*win)
  1067.  
  1068. ; MouseWait:End
  1069.  
  1070. ;-----------------------------------------------------------------
  1071.  
  1072. ; Statement : BFWindow { window, left, top, right, bottom, pen }
  1073.  
  1074. ; Original author : Unknown
  1075.  
  1076. ; Fixed for gimmezerozero windows by Carl Read :)
  1077.  
  1078. ; UPDATED (again) By Bippy - BippyM@stingent.freeserve.co.uk
  1079. ; Now you can (well, have to ;) supply the dimensions and pen
  1080. ; colour used...much more control :)
  1081.  
  1082. ; Fills a window with a backfill pattern, like this :
  1083.  
  1084. ;  010101010101010101010101010101010101
  1085. ;  101010101010101010101010101010101010
  1086. ;  010101010101010101010101010101010101
  1087. ;  101010101010101010101010101010101010
  1088. ;  010101010101010101010101010101010101
  1089. ;  101010101010101010101010101010101010
  1090. ;  010101010101010101010101010101010101
  1091.  
  1092. ; ...that kind of thing ;)
  1093. ; Looks all white, like requesters...
  1094.  
  1095. ; Good when used with WFBox {} - see .WFBox.
  1096.  
  1097. ; See the end of the statement for how to edit the pattern :)
  1098.  
  1099. ; WARNING - don't make the right or bottom values you supply
  1100. ; less than the left or top values... G U R U :)
  1101.  
  1102. Statement BFWindow{WindoID.w,WLeft,WTop,WWidth,WHeight,pen}
  1103.  
  1104. *Windo.Window = Peek.l(Addr Window(WindoID.w))
  1105. USEPATH *Windo
  1106.    \RPort\AreaPtrn = ?BackFill                   ;Pattern Address
  1107.    \RPort\AreaPtSz = 1                           ;use 2 arrays form the
  1108.                                                  ;Pattern Address
  1109.    If \Flags AND $400
  1110.      WLeft - WLeftOff
  1111.      WTop - WTopOff
  1112.    EndIf
  1113.  
  1114. ;Put a BackFill in the Window.
  1115.    SetAPen_ \RPort,pen
  1116.    SetDrMd_ \RPort,1
  1117.    BltPattern_ \RPort,0,WLeft,WTop,WWidth,WHeight,0
  1118.  
  1119.    \RPort\AreaPtrn = 0                           ;Put it back to 0
  1120.    \RPort\AreaPtSz = 0                           ;Put it back to 0
  1121.  
  1122. Statement Return
  1123.  
  1124. BackFill:
  1125. Dc.w %0101010101010101 ; first line...
  1126. Dc.w %1010101010101010 ; next line...
  1127. ;   ;%----------------   ...and repeats all down the window...
  1128.  
  1129. ; These 0's and 1's control the pattern -
  1130. ; edit them to change the pattern, but :
  1131.  
  1132. ; BEWARE : Using the wrong number of 0's and 1's WILL
  1133. ;          crash the machine!!!!!
  1134.  
  1135. ;          Use the -'s as a guide :)
  1136.  
  1137. End Statement
  1138.  
  1139. ; demo :
  1140.  
  1141. ; FindScreen 0
  1142. ; Window 0,0,0,320,127,$100e,"Crude backfill demo",1,2
  1143. ; BFWindow {0,20,20,300,100,2}
  1144. ; MouseWait:End
  1145.  
  1146. ;----------------------------------------------------------------
  1147.  
  1148. ; Statement : WindowTitle { window, window title, screen title }
  1149.  
  1150. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1151.  
  1152. ; Changes the title of the specified window (and the screen title
  1153. ; while the window is activated).
  1154.  
  1155. ; It's safe to supply a wrong window number - no Enforcer
  1156. ; hits or anything ;)
  1157.  
  1158. Statement WindowTitle { win.b, windowtitle$, screentitle$ }
  1159.     SetWindowTitles_ Peek.l(Addr Window(win)),&windowtitle$,&screentitle$
  1160. End Statement
  1161.  
  1162. ; demo :
  1163.  
  1164. ; FindScreen 0
  1165. ; Window 0,0,11,640,200,$140f,"I'm gonna change soon!",1,2
  1166. ; Delay_ 100
  1167.  
  1168. ; WindowTitle {0,"Hello, I've been changed!","Hey, look at me!"}
  1169.  
  1170. ; MouseWait:End
  1171.  
  1172. ;-----------------------------------------------------------------
  1173.  
  1174. ; Statement : WinCls { colour }
  1175.  
  1176. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1177.  
  1178. ; Same as WCls, but without the "Oops, I've missed the
  1179. ; top line" bug (see demo).
  1180.  
  1181. Statement WinCls {col.w}
  1182.     If col>256 Then col=0 ; max value in OS!
  1183.     SetRast_ RastPort (Used Window),col
  1184. End Statement
  1185.  
  1186. ; ALTERNATIVE VERSION (only uncomment if you comment
  1187. ;                      out the above version!)
  1188.  
  1189. ; Statement : WinCls { window number, colour }
  1190.  
  1191. ; Statement WinCls { win.b, col.w }
  1192. ;   SetRast_ RastPort (win),col
  1193. ; End Statement
  1194.  
  1195. ; This version lets you add the window number - if you
  1196. ; wanted to clear a load of windows, you'd normally have
  1197. ; to "Use Window" each one before calling WCls or WinCls{}.
  1198.  
  1199. ; might come in handy for someone!
  1200.  
  1201. ; demo :
  1202.  
  1203. ; FindScreen 0
  1204. ; Window 0,0,0,640,200,$140f,"",1,2
  1205.  
  1206. ; WCls 1 ; bugged Blitz command :P
  1207.  
  1208. ; Request "","Oops - look at the top line of the window!||It hasn't turned to colour 1!","Why, you're right..."
  1209.  
  1210. ;   WinCls {0}
  1211.  
  1212. ; Request "","OK, let's try again!","OK"
  1213.  
  1214. ;   WinCls {1}
  1215.  
  1216. ; Request "","That's better!","I vow to use WinCls {} from now on!"
  1217.  
  1218. ; End
  1219.  
  1220. ;-----------------------------------------------------------------
  1221.  
  1222. ; Statement : CleanBorder { window number }
  1223.  
  1224. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1225.  
  1226. ; Fixes the window's border's if they've been overdrawn.
  1227.  
  1228. ; You can check for the borders being messed up by checking
  1229. ; WaitEvent (or Event) for $4 and then calling this...also,
  1230. ; if your window gets resized, it can be handy to call this.
  1231.  
  1232. Statement CleanBorder {win.b}
  1233.   If Peek.l(Addr Window(win))
  1234.     RefreshWindowFrame_ Peek.l(Addr Window (win))
  1235.   EndIf
  1236. End Statement
  1237.  
  1238. ; demo :
  1239.  
  1240. ; FindScreen 0
  1241. ; Window 0,0,0,400,100,$100f,"",1,2
  1242. ; WBox 0,0,400,100,1
  1243. ; Delay_25
  1244. ; WColour 2,1:WLocate WLeftOff,20:NPrint "Yuk! The borders have been overwritten!  "
  1245. ; Delay_150
  1246.  
  1247. ; CleanBorder {0}
  1248.  
  1249. ; NPrint "...that's better! Click mouse to end..."
  1250. ; MouseWait:End
  1251.  
  1252. ;-----------------------------------------------------------------
  1253.  
  1254. ; Function : LockWindow { window }
  1255.  
  1256. ; Locks the specified window, puts up busy pointer.
  1257.  
  1258. ; Unlocked with the UnLockWindow {} statement.
  1259.  
  1260. ; IMPORTANT!!! You should store the result as a long
  1261. ; variable, as in the demo - this is needed for the
  1262. ; UnLockWindow {} statement!
  1263.  
  1264. Function.l LockWindow {win.l}
  1265.   lock.l=AllocMem_(SizeOf .Requester,1)
  1266.   If lock
  1267.     win=Peek.l(Addr Window(win))
  1268.     InitRequester_(lock)
  1269.     If Request_(lock,win)
  1270.       *Exec.Library=Peek.l(4)
  1271.       If *Exec\lib_Version=>39
  1272.         Dim tag.TagItem(1)
  1273.         tag(0)\ti_Tag=#WA_BusyPointer,-1
  1274.         tag(1)\ti_Tag=#TAG_END
  1275.         SetWindowPointerA_ win,&tag(0)
  1276.       EndIf
  1277.     Else
  1278.       FreeMem_ lock,SizeOf .Requester
  1279.       lock=0
  1280.     EndIf
  1281.   EndIf
  1282.   Function Return lock
  1283. End Function
  1284.  
  1285. ; demo : see demo for UnLockWindow {} statement below.
  1286.  
  1287. ;-----------------------------------------------------------------
  1288.  
  1289. ; Statement : UnLockWindow { window, lock }
  1290.  
  1291. ; Unlocks a window locked with the LockWindow {} function.
  1292.  
  1293. ; IMPORTANT!!!! The "lock" parameter is the value returned
  1294. ; from LockWindow {} , eg. lock.l=LockWindow {0}
  1295.  
  1296. ; You supply this value to this statement.
  1297.  
  1298. Statement UnlockWindow{win.l,lock.l}
  1299.   win=Peek.l(Addr Window(win))
  1300.   *Exec.Library=Peek.l(4)
  1301.   If *Exec\lib_Version=>39
  1302.     Delay_ 5
  1303.     Dim tag.TagItem(0)
  1304.     tag(0)\ti_Tag=#TAG_END
  1305.     SetWindowPointerA_ win,&tag(0)
  1306.   EndIf
  1307.   EndRequest_ lock,win
  1308.   FreeMem_ lock,SizeOf .Requester
  1309. End Statement
  1310.  
  1311. ; demo :
  1312.  
  1313. ; FindScreen 0
  1314.  
  1315. ; Window 0,0,0,640,100,$40f,"Delayed for 2 seconds",1,2
  1316. ; GTButton 0,0,0,0,200,10,"Click me!",0
  1317.  
  1318. ; AttachGTList 0,0
  1319.  
  1320. ; lock.l=LockWindow {0}
  1321.  
  1322. ;   Delay_ 100
  1323.  
  1324. ; If lock Then UnlockWindow {0,lock}
  1325.  
  1326. ;   Delay_ 100
  1327.  
  1328. ; End
  1329.  
  1330. ;-----------------------------------------------------------------
  1331.  
  1332. ; Statement : HidePointer { window }
  1333.  
  1334. ; Author : Serge Veuglers (I think! - from dark.lha on Aminet)
  1335.  
  1336. ; Hides the mouse pointer for the specified window.
  1337.  
  1338. Statement HidePointer {win.w}
  1339.  
  1340.   *wmem.l = ?EmptyPointer ; gets invisible image from EmptyPointer:
  1341.  
  1342.   SetPointer_ Peek.l(Addr Window(win)), *wmem, 0,0,1,1
  1343.   Statement Return ; avoids running into next part...
  1344.  
  1345. ; The next part is the "invisible image" for the pointer!
  1346.  
  1347. EmptyPointer:
  1348. Dcb.w 4,$0
  1349.  
  1350. End Statement
  1351.  
  1352. ; demo : see demo for ShowPointer {} statement below.
  1353.  
  1354. ;----------------------------------------------------------------
  1355.  
  1356. ; Statement : ShowPointer { window }
  1357.  
  1358. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1359.  
  1360. ; Shows the mouse pointer for the specified window, used
  1361. ; after calling HidePointer {} statement.
  1362.  
  1363. Statement ShowPointer {win}
  1364.   ClearPointer_ Peek.l(Addr Window(win))
  1365. End Statement
  1366.  
  1367. ; demo :
  1368.  
  1369. ;FindScreen 0
  1370. ;Window 0,0,0,350,70,$20140e,"Click "+Chr$(34)+"Pointer Off"+Chr$(34)+"!",1,2
  1371.  
  1372. ;GTButton 0,50,10,0,150,30,"Pointer Off",0
  1373. ;GTButton 0,51,170,0,150,30,"Pointer On",0
  1374.  
  1375. ;AttachGTList 0,0
  1376.  
  1377. ;loop
  1378. ;Select WaitEvent
  1379.  
  1380. ;  Case $40
  1381.  
  1382. ;    Select GadgetHit
  1383. ;      Case 50
  1384. ;        HidePointer{0}
  1385. ;        WTitle "Click outside to see pointer!"
  1386. ;      Case 51
  1387. ;        ShowPointer{0}
  1388. ;        WTitle "Click "+Chr$(34)+"Pointer Off"+Chr$(34)+"!"
  1389. ;    End Select
  1390.  
  1391. ;  Case $200
  1392. ;    End
  1393.  
  1394. ;End Select
  1395. ;Goto loop
  1396.  
  1397. ;End
  1398.  
  1399. ;-----------------------------------------------------------------
  1400.  
  1401. ; Statement : WPrint { x, y, text }
  1402.  
  1403. ; Author : James L Boyd
  1404.  
  1405. ; Replacement for "WLocate x,y:Print a$"
  1406.  
  1407. ; That's right : all of this makes a smaller executable than
  1408. ; just WLocate & Print!
  1409.  
  1410. ; Checks for window/screen existence and returns quietly if
  1411. ; one of them doesn't exist, so no crashes :)
  1412.  
  1413. ; Can be expanded to include user requirements for "JamMode",
  1414. ; pen settings and font if you wanted - mail me if you don't
  1415. ; know how to do it :)
  1416.  
  1417. Statement WPrint {x.w,y.w,a$}
  1418.  
  1419.   *scr.Screen=Peek.l(Addr Screen(Used Screen))
  1420.   *win.Window=Peek.l(Addr Window(Used Window))
  1421.  
  1422.   If *win=0 OR *scr=0
  1423.     Statement Return
  1424.   EndIf
  1425.  
  1426.   *rp=*win\RPort
  1427.  
  1428.   ; correct for gimmezerozero windows :
  1429.  
  1430.   If *win\Flags &$400
  1431.     x-(*scr\WBorLeft*2)
  1432.     y-*scr\BarHeight
  1433.   Else y+1
  1434.     x-*scr\WBorLeft
  1435.   EndIf
  1436.  
  1437.   DEFTYPE.IntuiText text
  1438.  
  1439.   text\FrontPen=1
  1440.   text\BackPen=0
  1441.   text\DrawMode=#JAM1
  1442.   text\LeftEdge=x
  1443.   text\TopEdge=y
  1444.   text\ITextFont=0
  1445.   text\IText=&a$
  1446.   text\NextText=0
  1447.  
  1448.   PrintIText_ *rp,&text,10,10
  1449.  
  1450. End Statement
  1451.  
  1452. ; demo :
  1453.  
  1454. ; FindScreen 0
  1455.  
  1456. ; Window 0,0,0,640,100,$20100f,"",1,2
  1457.  
  1458. ; WPrint {0,0,"Help me"}
  1459. ; MouseWait:End
  1460.  
  1461. ;-----------------------------------------------------------------
  1462.  
  1463. ; Statement : WFBox { window, left, right, top, bottom }
  1464.  
  1465. ; Clears a 0 (standard : grey) colour bordered box over a
  1466. ; filled window.
  1467.  
  1468. ; Good when used with BFWindow {} - see .BFWindow...
  1469.  
  1470. ; WARNING - don't make the right or bottom values you supply
  1471. ; less than the left or top values... G U R U :)
  1472.  
  1473. ; Updated - turned into a statement, because making it
  1474. ; return a value was pretty pointless. Also uses RectFill_
  1475. ; instead of BltBitMap_ since it doesn't use a pattern mask.
  1476.  
  1477. Statement WFBox {WindoID.w,WLeft.w,WTop.w,WWidth.w,WHeight.w}
  1478.  
  1479. *Windo.Window = Peek.l(Addr Window(WindoID))
  1480.  
  1481.    SetAPen_ *Windo\RPort,0
  1482.    RectFill_ *Windo\RPort,WLeft,WTop,WWidth,WHeight
  1483.    SetAPen_ *Windo\RPort,1
  1484.    Move_ *Windo\RPort,WLeft,WHeight
  1485.    Draw_ *Windo\RPort,WLeft,WTop
  1486.    Draw_ *Windo\RPort,WWidth,WTop
  1487.    SetAPen_ *Windo\RPort,2
  1488.    Draw_ *Windo\RPort,WWidth,WHeight
  1489.    Draw_ *Windo\RPort,WLeft,WHeight
  1490.  
  1491. End Statement
  1492.  
  1493. ; demo :
  1494.  
  1495. ; FindScreen 0
  1496. ; Window 0,0,0,320,127,$140e,"",1,2
  1497. ; WCls 3
  1498.  
  1499. ; WFBox {0,20,20,280,100}
  1500.  
  1501. ; MouseWait:End
  1502.  
  1503. ;-----------------------------------------------------------------
  1504. .
  1505. .Intuition
  1506.  
  1507. ;-----------------------------------------------------------------
  1508.  
  1509. ; This section deals with what I can only describe as
  1510. ; Intuition-related stuff like requesters, and a couple
  1511. ; of other bits 'n' pieces that didn't really fit into
  1512. ; the Windows category.
  1513.  
  1514. ;-----------------------------------------------------------------
  1515.  
  1516. ; Current routines :
  1517.  
  1518. ; LockReq         { title, body, gadget, type }
  1519. ; ASLFileRequest  { title, path, file, pattern }
  1520. ; RTReq           { title, body text, gadget }
  1521. ; EasyRequester   { window , title, text, gadget(s), flags }
  1522.  
  1523. ;-----------------------------------------------------------------
  1524.  
  1525. ; Function : LockReq { title, body, gadget, type }
  1526.  
  1527. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1528.  
  1529. ; Locks calling window,puts up requester - standard Request
  1530. ; (reqtype=0) or RTEZRequest (reqtype=1)
  1531.  
  1532. ; RTEZRequest does lock the window normally, but if the window
  1533. ; is closed during the program (eg. during iconify), then
  1534. ; re-opened,sometimes the requesters fail to lock! hence this
  1535. ; function ;)
  1536.  
  1537. ; Of course,you need to have a screen in use to call either
  1538. ; Request or RTEZRequest.
  1539.  
  1540. ; tl$=title
  1541. ; rq$=body text
  1542. ; gd$=gadget text (as normal - separate more than one gadget
  1543. ;                  with "|",eg "OK|Cancel" )
  1544. ; reqtype=0 for Request,1 for RTEZRequest
  1545.  
  1546. Function.b LockReq{tl$,rq$,gd$,reqtype.b}
  1547.  
  1548. lock.l=RTLockWindow (Used Window)
  1549.  
  1550. If reqtype
  1551.   rtrq.b=RTEZRequest (tl$,Replace$(rq$,"|",Chr$(10)),gd$)
  1552. Else rtrq.b=Request (tl$,rq$,gd$)
  1553. EndIf
  1554.  
  1555. If lock
  1556.   RTUnlockWindow Used Window,lock
  1557. EndIf
  1558.  
  1559. Function Return rtrq
  1560. End Function
  1561.  
  1562. ; demo:
  1563.  
  1564. ; WBenchToFront_:FindScreen 0
  1565.  
  1566. ; Window 0,0,0,640,200,$140f,"LockReq Demo - this window is locked!",1,2
  1567.  
  1568. ; CatchDosErrs
  1569.  
  1570. ; rt.b=LockReq{"Title","Body text","OK|Quit|Cancel",1}
  1571.  
  1572. ; NPrint "Gadget pressed : ",rt
  1573. ; NPrint ""
  1574. ; NPrint "Press mouse button..."
  1575. ; MouseWait:End
  1576.  
  1577. ;-----------------------------------------------------------------
  1578.  
  1579. ; Function : ASLFileRequest { title, path, file, pattern }
  1580.  
  1581. ; Author : Paul Burkey - burkey@bigfoot.com
  1582.  
  1583. ; This function uses OS functions to call up the ASL file
  1584. ; requester.
  1585.  
  1586. ; You MUST have a screen in use!
  1587.  
  1588. ; You can configure the size by altering the top,left,
  1589. ; width and height variables within the function.
  1590.  
  1591. ; IMPORTANT NOTE!!! You won't see anything different if you're
  1592. ; using a patch like RTPatch or MCP's Reqtools Patch function!
  1593.  
  1594. Function.s ASLFileRequest{title$,pathname$,filename$,pat$}
  1595.   *scr.Screen=Peek.l(Addr Screen(Used Screen))
  1596.  
  1597.   top.w=0
  1598.   left.w=0
  1599.   width.w=ScreenWidth/2 ; remove /2 for full-screen requester! ;)
  1600.   height.w=ScreenHeight
  1601.  
  1602.   Dim Tags.TagItem(10)
  1603.   Tags(0)\ti_Tag=#ASLFR_Screen,*scr
  1604.   Tags(1)\ti_Tag=#ASLFR_InitialPattern,&pat$
  1605.   Tags(2)\ti_Tag=#ASLFR_TitleText,&title$
  1606.   Tags(3)\ti_Tag=#ASLFR_InitialFile,&filename$
  1607.   Tags(4)\ti_Tag=#ASLFR_InitialDrawer,&pathname$
  1608.   Tags(5)\ti_Tag=#ASLFR_InitialLeftEdge,left
  1609.   Tags(6)\ti_Tag=#ASLFR_InitialTopEdge,top
  1610.   Tags(7)\ti_Tag=#ASLFR_InitialWidth,width
  1611.   Tags(8)\ti_Tag=#ASLFR_InitialHeight,height
  1612.   Tags(9)\ti_Tag=#TAG_END,0
  1613.  
  1614.   *filereq.FileRequester=AllocAslRequest_(#ASL_FileRequest,&Tags(0))
  1615.   If *filereq
  1616.     ok.l=AslRequest_(*filereq,&Tags(0))
  1617.     If ok
  1618.       f$=Peek.s(*filereq\fr_Drawer)
  1619.       If f$<>"" Then If Right$(f$,1)<>":" AND Right$(f$,1)<>"/" Then f$=f$+"/"
  1620.       f$=f$+Peek.s(*filereq\fr_File)
  1621.     EndIf
  1622.     FreeAslRequest_(*filereq)
  1623.   EndIf
  1624.   Function Return f$
  1625. End Function
  1626.  
  1627. ; demo :
  1628.  
  1629. ; FindScreen 0
  1630.  
  1631. ; NPrint "You selected: ",ASLFileRequest{"Choose File","s:","shell-startup",""}
  1632. ; MouseWait
  1633. ; End
  1634.  
  1635. ;-----------------------------------------------------------------
  1636.  
  1637. ; Function : RTReq { title, body text, gadget }
  1638.  
  1639. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1640.  
  1641. ; UPDATE - Curt Esser reported a silly bug in the OpenLibrary_
  1642. ;          call - FIXED.
  1643.  
  1644. ; Checks for reqtools.library v38 and uses a reqtools
  1645. ; requester if it's available, defaulting to the standard
  1646. ; requester if it's not.
  1647.  
  1648. ; I never made it use the reqtools positioning parameters,
  1649. ; as these get patched by the user's own prefs settings
  1650. ; anyway.
  1651.  
  1652. Function.b RTReq {title$,body$,gadget$}
  1653.  
  1654.   lib$="reqtools.library"
  1655.  
  1656.   *lib.l=OpenLibrary_(&lib$,38)
  1657.   If *lib
  1658.     CloseLibrary_ *lib
  1659.     body$=Replace$(body$,"|",Chr$(10))
  1660.     rt.b=RTEZRequest (title$,body$,gadget$)
  1661.   Else rt.b=Request (title$,body$,gadget$)
  1662.   EndIf
  1663.  
  1664. Function Return rt
  1665.  
  1666. End Function
  1667.  
  1668. ; demo :
  1669.  
  1670. ; If RTReq{"Hello","If you've got reqtools v38+,|I'll be a reqtools requester,|otherwise just a normal one!","OK|Cancel"}
  1671.  
  1672. ;   result.l=RTReq{"Result","You hit OK!","Yep..."}
  1673.  
  1674. ; Else result.l=RTReq{"Result","You hit Cancel!","Sure did!"}
  1675. ; EndIf
  1676. ; End
  1677.  
  1678. ;-----------------------------------------------------------------
  1679.  
  1680. ; Function : EasyRequester { win, title, text, gadget(s), flags }
  1681.  
  1682. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1683.  
  1684. ; + Help from David McMinn :)
  1685.  
  1686. ; Puts up an EasyRequest using the OS - can detect specific
  1687. ; IDCMP events, eg disk inserted/removed, etc (see p179 of
  1688. ; the Blitz 2 manual for a list).
  1689.  
  1690. ; This is essentially the same as RTEZFlagsRequest, but doesn't
  1691. ; need reqtools.library. The exec size is only slightly
  1692. ; smaller than when you use RTEZFlagsRequest, but may be useful
  1693. ; if you want to avoid using reqtools...?
  1694.  
  1695. ; Either supply a window number (if you've set up a window),
  1696. ; or you can specify -1 : this uses the Workbench window,
  1697. ; so that you don't even need a window (or screen) setup
  1698. ; yourself :)
  1699.  
  1700. ; You also supply the title, body text and gadget text (all
  1701. ; just like you do for Request (), and finally any IDCMP
  1702. ; flags you want to satisfy the requester, eg. $400 for any
  1703. ; keypress (see p179 of manual). Mutiple flags can be detected
  1704. ; by doing $400|$8 (key pressed or mouse button hit), etc...
  1705.  
  1706. ; Multiple flags always return ALL of the flags though, not
  1707. ; the one that answered the requester (same happens with
  1708. ; RTEZFlagsRequest).
  1709.  
  1710. ; To use as a normal requester, just put a flag of 0...but
  1711. ; make sure you don't supply "" as the gadget, or you're stuck ;)
  1712.  
  1713. ; It returns gadget numbers just like Request...
  1714.  
  1715. ; Note, you can supply "" for the gadget, so that your user
  1716. ; MUST do as they're told (eg insert disk, etc ;) ...NOT
  1717. ; RECOMMENDED though!!!!
  1718.  
  1719. Function.l EasyRequester {win,title$,body$,gadget$,flags.l}
  1720.  
  1721.   DEFTYPE.EasyStruct es
  1722.  
  1723. ; this is the work of a genius ;)
  1724.  
  1725.   If win<>-1 ; -1 - use WB window
  1726.     *win.Window=Peek.l(Addr Window(win))
  1727.   Else
  1728.     wb$="Workbench"
  1729.     *scr.Screen=LockPubScreen_(&wb$)
  1730.     If *scr
  1731.       *win.Window = *scr\FirstWindow
  1732.       While *win
  1733.         If *win\Flags & #WFLG_WBENCHWINDOW
  1734.         wb.b=-1
  1735.         Goto popit
  1736.         EndIf
  1737.         *win = *win\NextWindow
  1738.       Wend
  1739.     popit
  1740.     UnlockPubScreen_ 0,*scr
  1741.     If wb=0 Then Function Return 0
  1742.     EndIf
  1743.  
  1744.   EndIf
  1745.  
  1746.   If body$="" Then Function Return -1
  1747.  
  1748.   body$=Replace$ (body$,"|",Chr$(10))
  1749.  
  1750.   es\es_StructSize=SizeOf.EasyStruct
  1751.   es\es_Flags=0
  1752.   es\es_Title=&title$
  1753.   es\es_TextFormat=&body$
  1754.   If gadget$=""
  1755.     es\es_GadgetFormat=0
  1756.   Else es\es_GadgetFormat=&gadget$
  1757.   EndIf
  1758.  
  1759. Function Return EasyRequestArgs_ (*win,&es,&flags,0)
  1760. End Function
  1761.  
  1762. ; demo :
  1763.  
  1764. ;; Insert a disk in any drive (works for ANY type of disk, even
  1765. ;; CDs!) to continue, or click on gadget to abort...
  1766.  
  1767. ;; Try changing "Abort" gadget to "" !
  1768.  
  1769. ;; LOOK, NO SCREEN OR WINDOW (that's what the -1 does :)
  1770.  
  1771. ; If EasyRequester {-1,"","Insert disk in drive...","Abort",$8000}=$8000
  1772. ;   Request "","That's it!","OK"
  1773. ; Else  Request "","You aborted!","Oh..."
  1774. ; EndIf
  1775.  
  1776. ; End
  1777.  
  1778. ;-----------------------------------------------------------------
  1779. .
  1780. .Graphics
  1781.  
  1782. ;----------------------------------------------------------------
  1783.  
  1784. ; This section deals with graphics-related routines, like
  1785. ; picture/palette loading, depth->colour conversion, etc.
  1786.  
  1787. ;-----------------------------------------------------------------
  1788.  
  1789. ; Current routines :
  1790.  
  1791. ; CheckPic          { picture file }
  1792. ; PicSafe           { picture file, type, safety }
  1793. ; Planes2Cols       { number of bitplanes }
  1794. ; SavePaletteFile   { bitMap number, filename }
  1795. ; GetPaletteSize    { palette name }
  1796. ; UsePalette        { screen, palette }
  1797.  
  1798. ;-----------------------------------------------------------------
  1799.  
  1800. ; Function : CheckPic { picture file }
  1801.  
  1802. ; Author : Curt Esser - camge@ix.netcom.com
  1803.  
  1804. ; This function tests a picture file and returns a string
  1805. ; telling you what kind of file it is.
  1806.  
  1807. ; Handy for avoiding crashes when your user tries to load
  1808. ; a non-IFF image!
  1809.  
  1810. ; The returned string will be one of the following :
  1811.  
  1812. ;  "OK"    = normal ILBM pic
  1813. ;  "GIF"   = GIF pic
  1814. ;  "JPEG"  = Jpeg pic
  1815. ;  "HAM"   = ILBM/Ham pic
  1816. ;  "ANIM"  = Animation
  1817. ;  "24bit" = -1 Colour picture
  1818. ;  "????"  = Unrecognized file type
  1819. ;  "NF"    = File not found
  1820.  
  1821. Function.s CheckPic {picpath$}
  1822.  
  1823.   error$=""
  1824.  
  1825.   If ReadFile(0,picpath$) ; read file header
  1826.  
  1827.     FileInput 0
  1828.       header$ = Inkey$(2000) ; read 2000 bytes
  1829.     CloseFile 0
  1830.     PopInput
  1831.  
  1832.     If Left$(header$,4)<> "FORM" OR Mid$(header$,9,4) <> "ILBM"
  1833.       ; ^ Checks if it's IFF...if it's not an IFF, do this :
  1834.  
  1835.       If Left$(header$,3)="GIF" Then error$="GIF "
  1836.       If Mid$(header$,7,4)="JFIF" Then error$="JPEG"
  1837.       If Mid$(header$,9,4)="ANIM" Then error$="ANIM"
  1838.       If error$="" Then error$="????"
  1839.  
  1840.     Else  ; valid IFF header found!
  1841.  
  1842.       x.w=Instr(header$,"CAMG") ; check if it's a HAM pic
  1843.  
  1844.       If x<>0
  1845.         a$=Left$(Right$(Hex$(Peek.l(&header$+x+7) AND $88A4),3),1)
  1846.         If a$="8" Then error$="HAM "
  1847.       EndIf
  1848.  
  1849.       x=Instr(header$,"CMAP")   ;check for 24 bit pic!
  1850.       If x=0 Then error$="24bit"
  1851.  
  1852.     EndIf
  1853.  
  1854.     If error$="" Then error$="OK" ; yep, it's an IFF file!
  1855.  
  1856.   Else ; couldn't even find the file!
  1857.     error$="NF"
  1858.   EndIf
  1859. Function Return error$
  1860. End Function
  1861.  
  1862. ; demo :
  1863.  
  1864. ;; WARNING!!! You should insert the name of a file on YOUR
  1865. ;;            system before running this, in the CheckPic{}
  1866. ;;            part...
  1867.  
  1868. ; Request "","File format : "+CheckPic{"art:jpegs/santa.jpg"},"OK"
  1869. ; End
  1870.  
  1871. ;----------------------------------------------------------------
  1872.  
  1873. ; Function : PicSafe { picture file, type, safety }
  1874.  
  1875. ; Author : Curt Esser - camge@ix.netcom.com
  1876.  
  1877. ; Checks if there's enough chip memory to load a shape
  1878. ; or bitmap.
  1879.  
  1880. ; The function returns a long value :
  1881.  
  1882. ; 1) True (-1) if you can go ahead and load it
  1883. ; 2) The number of bytes needed if there's not enough
  1884.  
  1885. ; See demos...
  1886.  
  1887. ; The loadtype.b parameter should be :
  1888.  
  1889. ; 1) 0 if you're testing a bitmap
  1890. ; 2) 1 if you're testing a shape...
  1891.  
  1892. ; The safety.l parameter allows you to leave a certain
  1893. ; amount of memory (bytes) as a safety margin (I'd use
  1894. ; at least 50000 normally)...this is the bare minimum of
  1895. ; chip mem to leave available after loading the picture.
  1896.  
  1897. Function.l PicSafe{picpath$,loadtype.b,safety.l}
  1898.  
  1899.     ILBMInfo picpath$           ;read the pictures size information
  1900.  
  1901.     picDepth.w=ILBMDepth
  1902.     picDepth + loadtype         ;a shape needs an extra bitplane
  1903.     picHeight.w=ILBMHeight
  1904.     picWidth.w=ILBMWidth
  1905.     planemem.l=picHeight*picWidth/8  ;bytes needed for 1 bitplane of this pic
  1906.     totalmem.l=planemem*picDepth     ;total bytes needed for loading
  1907.  
  1908.     If AvailMem_ (131074)>totalmem+safety Then ok.l=-1 Else ok=totalmem
  1909.  
  1910.     ; you can replace 131074 with #MEMF_CHIP|#MEMF_LARGEST
  1911.     ; if you have Blitzlibs:amigalibs.res in Compiler Options...
  1912.  
  1913.   Function Return ok
  1914. End Function
  1915.  
  1916. ; demo :
  1917.  
  1918. ;; WARNING!!! You should insert the name of a file on YOUR
  1919. ;;            system before trying to run this!
  1920.  
  1921. ; result.l=PicSafe{"art:misc/santa.iff",0,50000}
  1922.  
  1923. ;; the above call uses 0 to check a bitmap, and 50000 bytes
  1924. ;; of safety memory.
  1925.  
  1926. ; If result=-1
  1927. ;   Request "","OK to load picture!","OK"
  1928. ; Else Request "","Not enough chip memory to load picture!|Needs "+Str$(a)+" bytes!","Abort!"
  1929. ; EndIf
  1930.  
  1931. ; End
  1932.  
  1933. ; demo 2 :
  1934.  
  1935. ;; DON'T RUN THIS!!! Just an alternative way of using it.
  1936.  
  1937. ; pic$="art:misc/santa.iff"
  1938.  
  1939. ; If PicSafe{pic$}=-1 Then LoadBitMap 0,pic$,0
  1940. ; MouseWait:End
  1941.  
  1942. ;-----------------------------------------------------------------
  1943.  
  1944. ; Function : Planes2Cols { number of bitplanes }
  1945.  
  1946. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  1947.  
  1948. ; Returns the number of colours available
  1949. ; in the number of bitplanes given.
  1950.  
  1951. Function.w Planes2Cols {planes.b}
  1952. colours.w=2^planes
  1953. Function Return colours
  1954. End Function
  1955.  
  1956. ; demo :
  1957.  
  1958. ; Print "An 8-plane bitmap has ",Planes2Cols {8}," colours."
  1959. ; MouseWait:End
  1960.  
  1961. ; demo 2 :
  1962.  
  1963. ;; WARNING!!! DO NOT RUN!
  1964. ;; This is an example of how it could be used...
  1965.  
  1966. ; cols.w=Planes2Cols {ILBMDepth} ; how many colours in currently
  1967. ;                                ; examined picture?
  1968.  
  1969. ;-----------------------------------------------------------------
  1970.  
  1971. ; Statement : SavePaletteFile { bitmap number, filename }
  1972.  
  1973. ; Author - "Cyanure"?
  1974.  
  1975. ; Saves the palette from a given bitmap to a file as a
  1976. ; standard Amiga IFF palette.
  1977.  
  1978. ; I think you have to use LoadBitMap with the palette
  1979. ; parameter (or load the palette manually), then call
  1980. ; this statement.
  1981.  
  1982. Statement SavePaletteFile {NumberBmap.b,FileName.s}
  1983.  
  1984.   DEFTYPE .b NumberPlanes
  1985.   DEFTYPE .w NumberColors,FSize
  1986.  
  1987.   NumberPlanes=Peek.b(Addr BitMap(NumberBmap)+5)
  1988.   NumberColors=2^NumberPlanes
  1989.   FSize=3*NumberColors+48               ; File size
  1990.  
  1991.   If OpenFile(1,FileName.s)=-1
  1992.     *pf=AllocMem_(FSize,0)          ; Memory for the palette file
  1993.     *pf0=*pf                        ; Beginning of the palette file
  1994.                                       address
  1995.     Poke.l *pf,$464f524d            ; FORM
  1996.     Poke.l *pf+4,FSize-8            ;
  1997.     Poke.l *pf+8,$494c424d          ; ILBM
  1998.     Poke.l *pf+12,$424d4844         ; BMHD
  1999.     Poke.l *pf+16,20                ; Size of the BMHD chunk
  2000.     Poke.l *pf+20,0                 ; width and height
  2001.     Poke.l *pf+24,0                 ; x and y
  2002.     Poke.l *pf+28,$03020180         ; I don't know why but it works !
  2003.     Poke.l *pf+32,0                 ; transparency and aspect
  2004.     Poke.l *pf+36,0                 ; page width and page height
  2005.     Poke.l *pf+40,$434d4150         ; CMAP
  2006.     Poke.l *pf+44,NumberColors*3    ; Size of the CMAP chunk
  2007.  
  2008.     *pf+48                          ; Increases the pointer
  2009.  
  2010.     For c=0 To NumberColors-1
  2011.       Poke.b *pf,AGARed(c)
  2012.       Poke.b *pf+1,AGAGreen(c)
  2013.       Poke.b *pf+2,AGABlue(c)
  2014.       *pf+3
  2015.     Next c
  2016.  
  2017.     WriteMem 1,*pf0,FSize            ; Writes in file #1
  2018.     FreeMem_ *pf0,FSize
  2019.     CloseFile 1
  2020.  
  2021.   EndIf
  2022.  
  2023. End Statement
  2024.  
  2025. demo :
  2026.  
  2027. ; NOTE : DO NOT run this demo as it requires specific
  2028. ; files - you'll have to replace all the filenames with some
  2029. ; from your own system before running!
  2030.  
  2031. ; The demo is from the original source by Cyanure.
  2032.  
  2033. ; WBStartup
  2034. ; NoCli
  2035.  
  2036. ; ; I suppose the palette you want to save is one of an open bitmap
  2037. ; ; So, I open such a bitmap :
  2038.  
  2039. ; Screen 0,0,0,320,256,8,0,"title",1,2
  2040. ; ScreensBitMap 0,0
  2041. ; LoadBitMap 0,"art:misc/amilogo.iff",0   ; chooses a bitmap
  2042. ; LoadPalette 0,"art:misc/amilogo.iff"
  2043. ; Use Palette 0
  2044.  
  2045. ; SavePaletteFile{0,"ram:PaletteStd.col"}
  2046.  
  2047. ; End
  2048.  
  2049. ;-----------------------------------------------------------------
  2050.  
  2051. ; Function : GetPaletteSize { palette name }
  2052.  
  2053. ; Returns the number of colours in a given palette.
  2054.  
  2055. ; NOT guaranteed to be future-proof, but I don't suppose
  2056. ; we need to worry about that now, do we? ;)
  2057.  
  2058. ; NOTE - not sure how reliable this is...
  2059.  
  2060. ; I found this somewhere (or maybe it was sent to me?)
  2061. ; Thought it would be useful to somebody, so I've chucked it
  2062. ; in with nearly no changes (could be optimised to use OS file
  2063. ; reading though... :)
  2064.  
  2065. Function.w GetPaletteSize{palname$}
  2066.   numbitplanes.w=0
  2067.   If ReadFile(0,palname$)
  2068.     FileSeek 0,28
  2069.     ReadMem 0,&numbitplanes,1
  2070.     CloseFile 0
  2071.   End If
  2072.   Function Return 2^numbitplanes
  2073. End Function
  2074.  
  2075. ; demo :
  2076.  
  2077. ;; NOTE : change the palette name to one on YOUR system!
  2078.  
  2079. ; NPrint GetPaletteSize {"sys:storage/clickforcolours"}
  2080. ; MouseWait:End
  2081.  
  2082. ;-----------------------------------------------------------------
  2083.  
  2084. ; Statement : UsePalette { screen, palette }
  2085.  
  2086. ; Author : Paul Burkey - burkey@bigfoot.com
  2087.  
  2088. ; Same as Use Palette, but using OS functions (smaller
  2089. ; executable size). Also has some other advantage, but I've
  2090. ; forgotten what it was!
  2091.  
  2092. Statement UsePalette{scr.w,pal.w}
  2093.   LoadRGB32_ ViewPort(scr),Peek.l(Addr Palette(pal))
  2094. End Statement
  2095.  
  2096. ; demo :
  2097.  
  2098. ; FindScreen 0,"Workbench Screen"
  2099.  
  2100. ;; WARNING!!! This will screw up your Workbench palette
  2101. ;; and I can't be bothered typing stuff to set it back!
  2102. ;; You may want to edit this before running ;)
  2103.  
  2104. ; LoadPalette 0,"Sys:Storage/clickforcolours"
  2105.  
  2106. ; if Request ("","I'm gonna change the screen colours!","OK|NO!")
  2107.  
  2108. ; UsePalette {0,0}
  2109.  
  2110. ; Delay_ 100
  2111.  
  2112. ; EndIf
  2113.  
  2114. ; End
  2115.  
  2116. ;----------------------------------------------------------------
  2117. .
  2118. .Sound
  2119.  
  2120. ;----------------------------------------------------------------
  2121.  
  2122. ; This section deals with sound-related routines, such as
  2123. ; safe loading, timing,etc.
  2124.  
  2125. ;-----------------------------------------------------------------
  2126.  
  2127. ; Current routines :
  2128.  
  2129. ; SoundSafe { sound file, safety }
  2130. ; SaveSound { sound number, filename }
  2131. ; SoundTime { sound number }
  2132.  
  2133. ;-----------------------------------------------------------------
  2134.  
  2135. ; Function : SoundSafe { sound file, safety }
  2136.  
  2137. ; checks a sound sample :
  2138.  
  2139. ; 1) To see if it's really an IFF sample
  2140. ; 2) To check there's enough memory to load it
  2141.  
  2142. ; The safety.l parameter is the number of bytes of safety
  2143. ; margin to add on...ie the bare minimum of chip mem to leave
  2144. ; available after loading the sound. I'd use about 50000
  2145. ; normally.
  2146.  
  2147. ; Returns a long value depending on the results :
  2148.  
  2149. ; 1) True (-1) if it's OK to load the sample
  2150. ; 2) the number of bytes needed if chip memory's too low
  2151. ; 3) False (0) if it's not an IFF sample
  2152. ; 4) 1 if it's not found...bit hacky, but pretty safe!
  2153.  
  2154. ; see demos...
  2155.  
  2156. Function.l SoundSafe {soundpath$,safety.l}
  2157.  
  2158.   If ReadFile(0,soundpath$) ; check file header
  2159.  
  2160.     FileInput 0
  2161.     header$ = Inkey$(12)    ; read 12 bytes
  2162.     CloseFile 0
  2163.     PopInput
  2164.  
  2165.     If Left$(header$,4)="FORM" AND Right$(header$,4)="8SVX"
  2166.  
  2167.       ;valid sample, now check chip memory
  2168.  
  2169.       chipmem.l=FileSize(soundpath$) ; memory needed
  2170.  
  2171.       If AvailMem_ (131074)>chipmem+safety Then ok.l=-1 Else ok=chipmem
  2172.  
  2173.     Else
  2174.       ok=0 ; not an IFF sample!
  2175.     EndIf
  2176.  
  2177.   Else
  2178.       ok=1 ; not found!
  2179.   EndIf
  2180.  
  2181.   Function Return ok
  2182.  
  2183. End Function
  2184.  
  2185. ; demo :
  2186.  
  2187. ;; NOTE that you need to change the filename to one on your
  2188. ;; own system!
  2189.  
  2190. ; result.l=SoundSafe{"sys:storage/goodjob.iff",50000}
  2191.  
  2192. ;; the above call uses 50000 bytes of safety margin.
  2193.  
  2194. ; Select result
  2195. ;   Case -1
  2196. ;     message$="OK to load sound!"
  2197. ;   Case 0
  2198. ;     message$="Not an IFF sample!"
  2199. ;   Case 1
  2200. ;     message$="Not found!"
  2201. ;   Default
  2202. ;     message$="Not enough memory - need "+Str$(result)+" bytes!"
  2203. ; End Select
  2204.  
  2205. ; Request "",message$,"OK"
  2206.  
  2207. ; End
  2208.  
  2209. ; demo 2 :
  2210.  
  2211. ;; quick call! NOTE - change the filename to one
  2212. ;; on your system!
  2213.  
  2214. ; If SoundSafe{"sys:storage/goodjob.iff",50000}=-1
  2215. ;   LoadSound 0,"sys:storage/goodjob.iff"
  2216. ; Else End
  2217. ; EndIf
  2218.  
  2219. ; MouseWait:End
  2220.  
  2221. ;-----------------------------------------------------------------
  2222.  
  2223. ; Function : SaveSound { sound number, filename }
  2224.  
  2225. ; Author : Curt Esser - camge@ix.netcom.com
  2226.  
  2227. ; AT LAST! Blitz Basic gets a sample SAVE routine!
  2228. ; Full credit to Curt Esser for this excellent routine!
  2229.  
  2230. ; Right, who's gonna make an IFF sample editor?!
  2231.  
  2232. ; Come on, we've got LoopSound, InitSound, SoundData, PeekSound,
  2233. ; etc, so it shouldn't be too hard to make it! (I'm too lazy ;)
  2234.  
  2235. ; UPDATE - demo fixed by Curt - it never checked for a failure
  2236. ;                               properly before!
  2237.  
  2238. Function.b SaveSound{samplenumber.w,saveIFF$}
  2239.  
  2240. If Peek.l(Addr Sound(samplenumber))                          ;make sure sample exists
  2241.  
  2242. ;   Now we read the necessary information into our variables
  2243.  
  2244.   sndstart.l=Peek.l(Addr Sound(samplenumber))                ;start of sample data
  2245.   slen.l=(Peek.w(Addr Sound (samplenumber)+6) AND $FFFF)*2   ;bytes of sample data
  2246.  
  2247. ; -- the total disk file length less 8 bytes for "FORM" + length:
  2248.  
  2249.   tlen.l=slen+40
  2250.  
  2251. ; -- the looping information:
  2252.  
  2253.   loop.l=Peek.l(Addr Sound (samplenumber)+8)                 ;start of looping part
  2254.   lpln.l=(Peek.w(Addr Sound (samplenumber)+12) AND $FFFF)*2  ;length of loop
  2255.   ones.l=loop-sndstart                                       ;length of 1 shot part
  2256.   cycl.l=32                                                  ;seems to be standard?
  2257.  
  2258. ; -- the frequency:
  2259.  
  2260.   per.l=(Peek.w(Addr Sound(samplenumber)+4) AND $FFFF)       ;the sample period
  2261.   persec.w= 3579440/per                                      ;the actual frequency
  2262.  
  2263.   If WriteFile (0,saveIFF$)
  2264.     error=-1
  2265.     FileOutput 0
  2266.     Print "FORM"             ;start of IFF header
  2267.     WriteMem 0,&tlen,4       ;total bytes following the header
  2268.     Print "8SVXVHDR"         ;8svx sample ID, and start of Voice Header
  2269.     temp.l=20
  2270.     WriteMem 0,&temp,4       ;bytes in Voice Header chunk
  2271.     WriteMem 0,&ones,4       ;data bytes in 1 shot part
  2272.     temp.l=0
  2273.     WriteMem 0,&lpln,4       ;for looping (length of loop)
  2274.     WriteMem 0,&cycl,4       ;"     "     "
  2275.     WriteMem 0,&persec,2     ;frequency of the sample
  2276.     tempb.b=1
  2277.     WriteMem 0,&tempb,1      ;octaves
  2278.     WriteMem 0,&temp,1       ;compression (we use 0 = not compressed)
  2279.     temp.l=65536             ;volume (full volume)
  2280.     WriteMem 0,&temp,4
  2281.     Print "BODY"             ;start of Body chunk
  2282.     WriteMem 0,&slen,4       ;bytes of actual sample data
  2283.     WriteMem 0,sndstart,slen ;OK, finally!  Write the data
  2284.     CloseFile 0
  2285.     Use Window 0
  2286.   Else                       ;DOS error - could not save the file!
  2287.     error=1
  2288.   EndIf
  2289.  
  2290. Else
  2291.   error=0                    ;sorry, that sample doesn't exist!
  2292. EndIf
  2293.  
  2294. Function Return error
  2295.  
  2296. End Function
  2297.  
  2298. ; demo :
  2299.  
  2300. ;; DO NOT run this demo until you've replaced the sample
  2301. ;; names given!
  2302.  
  2303. ; LoadSound 0,"ram:test.iff"}
  2304.  
  2305. ; Delay_ 100 ; shouldn't be needed, but just in case...!
  2306.  
  2307. ; ok.b=SaveSound {0,"ram:copy_of_test.iff"}
  2308.  
  2309. ; Select ok     ;if ok<>-1  an error occurred!
  2310. ;   Case 0
  2311. ;     Request "","You don't have a sample loaded ","Doh!"
  2312. ;   Case 1
  2313. ;     Request "","Disk error - sample not saved","OH NO!"
  2314. ; End Select
  2315.  
  2316. ; End
  2317.  
  2318. ;-----------------------------------------------------------------
  2319.  
  2320. ; Function SoundTime { sound number }
  2321.  
  2322. ; Author : Curt Esser - camge@ix.netcom.com
  2323.  
  2324. ; Returns number of vblanks taken to play the given
  2325. ; sound at the default rate.
  2326.  
  2327. Function.w SoundTime {snd.w}
  2328.  
  2329.   If NTSC=-1
  2330.     vrate.b=60
  2331.   Else
  2332.     vrate.b=50
  2333.   EndIf
  2334.  
  2335.   period.w=Peek.w(Addr Sound (snd)+4) ;get the period from sound object
  2336.   l.l=Peek.w(Addr Sound (snd)+6)      ;get the length from sound object
  2337.   If l<0 Then l+64000                 ;correct for unsigned value if needed
  2338.   lngth.l=l*2                         ;convert to true length of sample
  2339.   frequency.f = 3579440/period        ;convert to true frequency
  2340.   delay.w=lngth/(frequency/vrate)     ;convert to playing time in VBlanks
  2341.   delay+5                             ;add a bit of padding for short samples
  2342.  
  2343.   Function Return delay
  2344.  
  2345. End Function
  2346.  
  2347. ; demo :
  2348.  
  2349. ;; IMPORTANT!!! Alter filename below to a sample on your disk!
  2350.  
  2351. ; LoadSound 0,"sys:storage/goodjob.iff"
  2352.  
  2353. ; NPrint ""
  2354. ; NPrint "Playing sample..."
  2355. ; NPrint ""
  2356.  
  2357. ; Sound 0,15
  2358.  
  2359. ; VWait SoundTime{0} ; wait until sample has finished before printing info :
  2360.  
  2361. ; NPrint "Sound 0 uses ",SoundTime{0}," vblanks..."
  2362.  
  2363. ; MouseWait:End
  2364.  
  2365. ;-----------------------------------------------------------------
  2366. .
  2367. .Hardware
  2368.  
  2369. ;----------------------------------------------------------------
  2370.  
  2371. ; This section deals with routines which find hardware
  2372. ; information, as well as routines which directly access
  2373. ; hardware instead of using the OS (and therefore might
  2374. ; not be future-compatible).
  2375.  
  2376. ; Where this is the case, I've marked the routines with :
  2377. ; "NOTE - Direct hardware access (may not be future-compatible)."
  2378.  
  2379. ;-----------------------------------------------------------------
  2380.  
  2381. ; Current routines :
  2382.  
  2383. ; GoNTSC {}
  2384. ; GoPAL {}
  2385. ; FilterOn {}
  2386. ; FilterOff {}
  2387. ; ChipSet {}
  2388. ; Unhook { device: }
  2389. ; Hookup { device: }
  2390. ; IsAGA{}
  2391. ; GetCPU {}
  2392. ; GetFPU {}
  2393. ; KeyCodeR {}
  2394. ; NewNTSC {}
  2395.  
  2396. ;-----------------------------------------------------------------
  2397.  
  2398. ; Statement : GoNTSC {}
  2399.  
  2400. ; Blitz's ForceNTSC causes an Enforcer hit - this doesn't :)
  2401.  
  2402. ; NOTE - Direct hardware access (may not be future-compatible).
  2403.  
  2404. Statement GoNTSC {}
  2405.   MOVE #0,$dff1dc
  2406. End Statement
  2407.  
  2408. ; demo :
  2409.  
  2410. ; See GoPAL{}
  2411.  
  2412. ;-----------------------------------------------------------------
  2413.  
  2414. ; Statement : GoPAL {}
  2415.  
  2416. ; Blitz's ForcePAL causes an Enforcer hit - this doesn't :)
  2417.  
  2418. ; NOTE - Direct hardware access (may not be future-compatible).
  2419.  
  2420. Statement GoPAL {}
  2421.   MOVE #32,$dff1dc
  2422. End Statement
  2423.  
  2424. ; demo :
  2425.  
  2426. ;; NOTE that this demo calls GoNTSC {} as well.
  2427.  
  2428. ; If NTSC
  2429. ;   Request "","Going into PAL mode for two seconds...","OK"
  2430. ;   GoPAL {}
  2431. ;   Delay_100
  2432. ;   GoNTSC {}
  2433. ; Else
  2434. ;   Request "","Going into NTSC mode for two seconds...","OK"
  2435. ;   GoNTSC {}
  2436. ;   Delay_100
  2437. ;   GoPAL {}
  2438. ; EndIf
  2439.  
  2440. ; End
  2441.  
  2442. ;-----------------------------------------------------------------
  2443.  
  2444. ; Statement : FilterOn {}
  2445.  
  2446. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2447.  
  2448. ; Switches hardware filter on, like "Filter", but saves
  2449. ; a tiny amount on executable size ;)
  2450.  
  2451. ; Switching the filter on cuts out higher frequencies,
  2452. ; making the sound more muffled, but reducing noise.
  2453.  
  2454. ; NOTE : If you must use the Filter command still, the
  2455. ; "controls" are reversed! "Filter On" turns it off,
  2456. ; and vice versa!
  2457.  
  2458. ; NOTE - Direct hardware access (may not be future-compatible).
  2459.  
  2460. Statement FilterOn {}
  2461.   Poke.b $bfe001,0
  2462. End Statement
  2463.  
  2464. ; demo : see demo for FilterOff {}
  2465.  
  2466. ;-----------------------------------------------------------------
  2467.  
  2468. ; Statement : FilterOff {}
  2469.  
  2470. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2471.  
  2472. ; Switches hardware filter off, like "Filter", but saves
  2473. ; a tiny amount on executable size ;)
  2474.  
  2475. ; NOTE : If you must use the Filter command still, the
  2476. ; "controls" are reversed! "Filter On" turns it off,
  2477. ; and vice versa!
  2478.  
  2479. ; NOTE - Direct hardware access (may not be future-compatible).
  2480.  
  2481. Statement FilterOff {}
  2482.   Poke.b $bfe001,2
  2483. End Statement
  2484.  
  2485. ; demo :
  2486.  
  2487. ;; NOTE: Replace "goodjob.iff" with a sample on YOUR
  2488. ;; hard drive!
  2489.  
  2490. ; LoadSound 0,"sys:storage/goodjob.iff"
  2491.  
  2492. ; FilterOn {}
  2493.  
  2494. ; Sound 0,15
  2495. ; Delay_100
  2496.  
  2497. ; FilterOff {}
  2498.  
  2499. ; Sound 0,15
  2500. ; Delay_100
  2501. ; End
  2502.  
  2503. ;-----------------------------------------------------------------
  2504.  
  2505. ; Function : ChipSet {}
  2506.  
  2507. ; Returns a string according to chipset in the
  2508. ; Amiga it's run on (OCS/ECS/AGA/AAA(!)/Unknown).
  2509.  
  2510. ; NOTE - Direct hardware access (may not be future-compatible).
  2511.  
  2512. ; I THINK this does direct hardware access anyway - the Lisa
  2513. ; command deals with finding the chipset.
  2514.  
  2515. Function.s ChipSet {}
  2516.  
  2517.   chip.w=Lisa
  2518.  
  2519.   Select chip
  2520.     Case $00
  2521.       chip$="OCS"
  2522.     Case $F7
  2523.       chip$="ECS"
  2524.     Case $F8
  2525.       chip$="AGA"
  2526.     Case $F9
  2527.       chip$="AAA (Prototype)"
  2528.   Default
  2529.     chip$="unknown"
  2530.   End Select
  2531.  
  2532. Function Return chip$
  2533. End Function
  2534.  
  2535. ; demo :
  2536.  
  2537. ; Request "","This is an "+ChipSet{}+" Amiga!","OK"
  2538. ; End
  2539.  
  2540. ;-----------------------------------------------------------------
  2541.  
  2542. ; Function : Unhook { device: }
  2543.  
  2544. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2545.  
  2546. ; "Unplugs" the specified drive.
  2547.  
  2548. ; IMPORTANT!!! This function can be very dangerous if you
  2549. ; don't know what you're doing!!!
  2550.  
  2551. ; Don't call it on the DISK's name, call it on the
  2552. ; DEVICE name (if you don't know what that means, you shouldn't
  2553. ; be using this!)...using the disk name will "busy" the disk,
  2554. ; but won't be able to "reconnect" it (see Hookup{} function)
  2555. ; because the OS asks you to insert the disk (whereas it won't
  2556. ; ask for the device). Therefore this returns 0 if you try
  2557. ; to do that.
  2558.  
  2559. Function.b Unhook {device$}
  2560.  
  2561.   If DeviceName$(device$)=device$ Then Function Return 0
  2562.  
  2563.   If Inhibit_(&device$, -1)
  2564.     Function Return -1
  2565.   Else Function Return 0
  2566.   EndIf
  2567.  
  2568. End Function
  2569.  
  2570. ; demo :
  2571.  
  2572. ; The demo's in the Hookup {} demo section...
  2573.  
  2574. ;-----------------------------------------------------------------
  2575.  
  2576. ; Function : Hookup { device: }
  2577.  
  2578. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2579.  
  2580. ; "Reconnects" the specified drive, disconnected with
  2581. ; Unhook {}.
  2582.  
  2583. ; IMPORTANT!!! This function can be very dangerous if you
  2584. ; don't know what you're doing!!!
  2585.  
  2586. ; Don't call it on the disk's name, call it on the
  2587. ; DEVICE name (if you don't know what that means, don't
  2588. ; mess with it!)...see Unhook{} function.
  2589.  
  2590. Function.b Hookup {device$}
  2591.  
  2592.   If Inhibit_(&device$, 0)
  2593.     Function Return -1
  2594.   Else Function Return 0
  2595.   EndIf
  2596.  
  2597. End Function
  2598.  
  2599. ; demo :
  2600.  
  2601. ;; WARNING!!! Do NOT test until you've saved all work!!!
  2602.  
  2603. ; NoCli
  2604.  
  2605. ; dr$="SYS:"
  2606.  
  2607. ; r$="WARNING!!!||This demo will make your "+dr$+" partition BUSY for a while!||Click on Cancel to Abort!||Click on OK "
  2608. ; r$+"if all work is saved...||You'll have to reboot if it fails to reconnect the drive!"
  2609.  
  2610. ; If Request ("",r$,"OK|Cancel")=0 Then End
  2611.  
  2612. ; If Unhook {dr$}
  2613. ;   Request "","Go and try to access the "+dr$+" drive before|you click on OK...","OK"
  2614. ;   If Hookup {dr$}=0 Then Request "","* Failed! *||Uh-oh...I'd better re-boot!","Reboot":ColdReboot_
  2615. ; EndIf
  2616.  
  2617. ; End
  2618.  
  2619. ;-----------------------------------------------------------------
  2620.  
  2621. ; Function : IsAGA{}
  2622.  
  2623. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2624.  
  2625. ; Returns True (-1) if it's an AGA machine. This makes for
  2626. ; a much smaller executable than CheckAGA (around half-size :)
  2627.  
  2628. ; Note that AGA is only activated after AGA machines have
  2629. ; their SetPatch program run!
  2630.  
  2631. Function.b IsAGA {}
  2632.  
  2633. lib$="graphics.library"
  2634. *gfxbase.GfxBase=OpenLibrary_(&lib$,33)
  2635.  
  2636. If *gfxbase
  2637.   If *gfxbase\ChipRevBits0 AND #GFXB_AA_ALICE
  2638.     aga.b=-1
  2639.   Else aga=0
  2640.   EndIf
  2641.   CloseLibrary_ *gfxbase
  2642. EndIf
  2643.  
  2644. Function Return aga
  2645. End Function
  2646.  
  2647. ; demo :
  2648.  
  2649. ; If IsAGA{} Then Request "","AGA!","OK" Else Request "","Non-AGA!","OK"
  2650. ; End
  2651.  
  2652. ;; That's right! All of the above, including the function itself, gives
  2653. ;; a smaller executable than this :
  2654.  
  2655. ; If CheckAGA Then Request "","AGA!","OK" Else Request "","Non-AGA!","OK"
  2656. ; End
  2657.  
  2658. ;; Compile 'em separately and see :)
  2659.  
  2660. ;-----------------------------------------------------------------
  2661.  
  2662. ; Function : GetCPU {}
  2663.  
  2664. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2665.  
  2666. ; Returns the type of (68k!) processor installed in the system.
  2667.  
  2668. ; Return values :
  2669.  
  2670. ; 0 = 68000
  2671. ; 1 = 68010
  2672. ; 2 = 68020
  2673. ; 3 = 68030
  2674. ; 4 = 68040    ; note - no 5! ;)
  2675. ; 6 = 68060
  2676.  
  2677. Function.b GetCPU {}
  2678.  
  2679.   cpu.b=0
  2680.   *e.ExecBase = Peek.l(4)
  2681.  
  2682.   #AFF_68060=(1 LSL 7)                  ; flag for 060, not in Blitz includes
  2683.  
  2684.   If *e
  2685.  
  2686.   If *e\AttnFlags & #AFF_68010          ; gotta do it like this,
  2687.     If *e\AttnFlags & #AFF_68020        ; cos each processor has the
  2688.       If *e\AttnFlags & #AFF_68030      ; flags of the previous processor
  2689.         If *e\AttnFlags & #AFF_68040    ; set, too...
  2690.           If *e\AttnFlags & #AFF_68060
  2691.             cpu=6
  2692.           Else cpu=4
  2693.           EndIf
  2694.         Else cpu=3
  2695.         EndIf
  2696.       Else cpu=2
  2697.       EndIf
  2698.     Else cpu=1
  2699.     EndIf
  2700.   Else cpu=0
  2701.   EndIf
  2702.  
  2703.   EndIf
  2704.  
  2705. Function Return cpu
  2706. End Function
  2707.  
  2708. ; demo :
  2709.  
  2710. ; NPrint "You have a 680",GetCPU{},"0 processor..."
  2711. ; MouseWait:End
  2712.  
  2713. ;-----------------------------------------------------------------
  2714.  
  2715. ; Function : GetFPU {}
  2716.  
  2717. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2718.  
  2719. ; Returns the type of FPU (if any) installed in the system.
  2720.  
  2721. ; Return values :
  2722.  
  2723. ; 0 = No FPU
  2724. ; 1 = 68881 FPU
  2725. ; 2 = 68882 FPU
  2726. ; 3 = 68040 FPU (no math emulation) ; 040.library not loaded
  2727. ; 4 = 68040 FPU (math emulation)
  2728. ; 5 = 68060 FPU (no math emulation) ; 060.library not loaded
  2729. ; 6 = 68060 FPU (math emulation)
  2730.  
  2731. Function.b GetFPU {}
  2732.  
  2733.   fpu.b=0
  2734.   *e.ExecBase = Peek.l(4)
  2735.  
  2736.   #AFF_68060=(1 LSL 7)
  2737.  
  2738.   If *e
  2739.  
  2740.   If *e\AttnFlags & #AFF_68881
  2741.     If *e\AttnFlags & #AFF_68882
  2742.       fpu=2
  2743.     Else fpu=1
  2744.     EndIf
  2745.  
  2746.     If *e\AttnFlags & #AFF_FPU40
  2747.       fpu=4                         ; 68040 FPU (math emulation)
  2748.       If *e\AttnFlags & #AFF_68060  ; check for 060...
  2749.         fpu=6                       ; 68060 FPU (math emulation)
  2750.       EndIf
  2751.     EndIf
  2752.  
  2753.   Else fpu=0                        ; No 68881 or 68882
  2754.  
  2755.     If *e\AttnFlags & #AFF_FPU40    ; check if it's an 040 without 6888x emulation...
  2756.       fpu=3                         ; 68040 FPU (no math emulation)
  2757.       If *e\AttnFlags & #AFF_68060  ; check for 060...
  2758.         fpu=5                       ; 68060 FPU (no math emulation)
  2759.       EndIf
  2760.     EndIf
  2761.  
  2762.   EndIf
  2763.  
  2764.   EndIf
  2765.  
  2766. Function Return fpu
  2767. End Function
  2768.  
  2769. ; demo :
  2770.  
  2771. ; Select GetFPU{}
  2772. ;   Case 0
  2773. ;     fpu$="None"
  2774. ;   Case 1
  2775. ;     fpu$="68881"
  2776. ;   Case 2
  2777. ;     fpu$="68882"
  2778. ;   Case 3
  2779. ;     fpu$="68040 FPU (no math emulation)"
  2780. ;   Case 4
  2781. ;     fpu$="68040 FPU (math emulation)"
  2782. ;   Case 5
  2783. ;     fpu$="68060 FPU (no math emulation)"
  2784. ;   Case 6
  2785. ;     fpu$="68060 FPU (math emulation)"
  2786. ; End Select
  2787.  
  2788. ; NPrint "Your FPU type : ",fpu$
  2789. ; MouseWait:End
  2790.  
  2791. ;-----------------------------------------------------------------
  2792.  
  2793. ; Function : KeyCodeR {}
  2794.  
  2795. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2796.  
  2797. ; NOTE - this is adapted from Paul Bowlay's BlitzOp.guide.
  2798.  
  2799. ; Size-saving replacement for KeyCode.
  2800.  
  2801. ; A test program using Blitz's "KeyCode" turned out an
  2802. ; executable of 19 K/bytes; replacing KeyCode with this
  2803. ; function resulted in an executable of 3 K/bytes!
  2804.  
  2805. ; Unlikely to be future-proof, since it reads the hardware
  2806. ; directly, but then, I'd guess KeyCode does too ;)
  2807.  
  2808. ; NOTE - Direct hardware access (may not be future-compatible).
  2809.  
  2810. Function.w KeyCodeR {}
  2811.   Function Return Peek($bfec00) AND $ff
  2812. End Function
  2813.  
  2814. ; demo :
  2815.  
  2816. ;; IMPORTANT!!! Click outside the Blitz CLI window before
  2817. ;; pressing any keys, or you'll just stop the CLI output!
  2818.  
  2819. ;; press ESCAPE to stop!
  2820.  
  2821. ; Repeat
  2822. ;   VWait
  2823. ;   e.w=KeyCodeR {}
  2824. ;   NPrint e
  2825. ; Until e=117
  2826. ; End
  2827.  
  2828. ;-----------------------------------------------------------------
  2829.  
  2830. ; Function : NewNTSC {}
  2831.  
  2832. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2833.  
  2834. ; Exec-size saving replacement for NTSC.
  2835.  
  2836. Function.b NewNTSC {}
  2837.  
  2838.   lib$="graphics.library"
  2839.   *gb.GfxBase=OpenLibrary_(&lib$,0)
  2840.  
  2841.   If *gb
  2842.     If *gb\DisplayFlags AND #REALLY_PAL Then p.b=0 Else p=-1
  2843.     CloseLibrary_ *gb
  2844.   EndIf
  2845.  
  2846.   Function Return p
  2847. End Function
  2848.  
  2849. ; demo :
  2850.  
  2851. ; If NewNTSC {}
  2852. ;   NPrint "NTSC machine."
  2853. ; Else NPrint "PAL machine."
  2854. ; EndIf
  2855.  
  2856. ; MouseWait:End
  2857.  
  2858. ;-----------------------------------------------------------------
  2859. .
  2860. .Strings
  2861.  
  2862. ;----------------------------------------------------------------
  2863.  
  2864. ; This section contains routines which manipulate strings in
  2865. ; some way.
  2866.  
  2867. ;-----------------------------------------------------------------
  2868.  
  2869. ; Current routines :
  2870.  
  2871. ; Quoted      { text }
  2872. ; StripToDot  { filename }
  2873. ; Value       { number as string }
  2874. ; SLen        { string }
  2875.  
  2876. ;-----------------------------------------------------------------
  2877.  
  2878. ; Function : Quoted { text }
  2879.  
  2880. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2881.  
  2882. ; Puts quotes around a file name,so that if your user has
  2883. ; entered a file name containing spaces,it'll still be OK.
  2884.  
  2885. ; Useful for some file requester returned strings,or appicons.
  2886.  
  2887. Function.s Quoted{a$}
  2888.  
  2889. a$=Chr$(34)+a$+Chr$(34)
  2890.  
  2891.   Function Return a$
  2892. End Function
  2893.  
  2894. ; demo :
  2895.  
  2896. ; Print "Enter a file name containing spaces : "
  2897. ; f$=Edit$(30)
  2898.  
  2899. ; NPrint "":NPrint Quoted{f$}
  2900. ; MouseWait:End
  2901.  
  2902. ;-----------------------------------------------------------------
  2903.  
  2904. ; Function : StripToDot { filename }
  2905.  
  2906. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2907.  
  2908. ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk
  2909. ;          - small optimisation!
  2910.  
  2911. ; I use this in a program to strip file extensions off.
  2912. ; eg. doing StripToDot{"reqtools.library"} would return
  2913. ; just "reqtools".
  2914.  
  2915. ; NOTE : some files will have more than one dot (period) !
  2916.  
  2917. Function.s StripToDot{a$}
  2918.   For a.w=Len(a$) To 1 Step -1
  2919.     If Mid$(a$,a,1)="." Then a$=Left$(a$,a-1):a=1
  2920.   Next a
  2921.   Function Return a$
  2922. End Function
  2923.  
  2924. ; demo :
  2925.  
  2926. ; Print "Enter a string with an extension (eg help.txt) : "
  2927. ; a$=StripToDot{Edit$(25)}
  2928.  
  2929. ; NPrint "":Print "New name : ",a$
  2930. ; NPrint "":NPrint "Click the mouse to end..."
  2931.  
  2932. ; MouseWait:End
  2933.  
  2934. ; demo 2 :
  2935.  
  2936. ;; I use it along with StripFile{} to just return
  2937. ;; the file part of a path & file (eg "Work:Pics/Amiga.iff"
  2938. ;; will be returned as "Amiga".
  2939.  
  2940. ; a$=StripToDot{ StripFile{"Work:Pics/Amiga.iff"} }
  2941. ; NPrint a$:MouseWait:End
  2942.  
  2943. ;-----------------------------------------------------------------
  2944.  
  2945. ; Function : Value { number as string }
  2946.  
  2947. ; Author : Curt Esser - camge@ix.netcom.com
  2948.  
  2949. ; This function returns correct values
  2950. ; for very large numbers - Blitz doesn't!
  2951.  
  2952. ; Probably saves quite a bit on executable size too.
  2953.  
  2954. Function.l  Value {input$}
  2955.   valu.l=0
  2956.   chars.w=StrToLong_(&input$,&valu)
  2957.   Function Return valu
  2958. End Function
  2959.  
  2960. ; demo :
  2961.  
  2962. ; test$="1087504386"
  2963.  
  2964. ; NPrint "Blitz's Val      : ",Val(test$)
  2965. ; NPrint "Value{} function : ",Value{test$}
  2966.  
  2967. ; MouseWait
  2968. ; End
  2969.  
  2970. ;-----------------------------------------------------------------
  2971.  
  2972. ; Function : SLen { string }
  2973.  
  2974. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  2975.  
  2976. ; Executable-size-saving replacement for Len ().
  2977.  
  2978. Function.l SLen{a$}
  2979.   stlen.l=Peek.l(&a$-4)
  2980. Function Return stlen
  2981. End Function
  2982.  
  2983. ; demo :
  2984.  
  2985. ; NPrint SLen{"Hello"}
  2986. ; MouseWait:End
  2987.  
  2988. ;-----------------------------------------------------------------
  2989. .
  2990. .FileIO
  2991.  
  2992. ;----------------------------------------------------------------
  2993.  
  2994. ; This section contains routines that involve disk
  2995. ; or file access in general.
  2996.  
  2997. ;-----------------------------------------------------------------
  2998.  
  2999. ; Current routines :
  3000.  
  3001. ; ShowInfo      { directory, icon, screen number }
  3002. ; StripFile     { path & file name }
  3003. ; CreateDir     { new directory }
  3004. ; CheckLib      { library, version }
  3005. ; OSAssign      { assign name, path, type }
  3006. ; Del           { file }
  3007. ; OpenShell     { x, y, width, height, title, flag(s) }
  3008. ; Name          { old file name, new name For File }
  3009. ; FileTime      { filename }
  3010. ; FileDate      { filename }
  3011. ; SetComment    { filename, comment }
  3012. ; ReadComment   { filename }
  3013. ; Exist         { filename }
  3014. ; CompareDates  { file 1, file 2 }
  3015. ; RunFromWB     { program }
  3016. ; ShowWhy       {}
  3017. ; SetProtect    { file, flags }
  3018. ; AskForDisk    { disk name }
  3019. ; DelIcon       { icon }
  3020.  
  3021. ;-----------------------------------------------------------------
  3022.  
  3023. ; Statement : ShowInfo { directory, icon, screen number }
  3024.  
  3025. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3026.  
  3027. ; Puts up the icon information requester (or replacement like
  3028. ; SwazInfo/WBInfo) onto the requested screen.
  3029.  
  3030. ; You supply :
  3031.  
  3032. ; 1) The directory of the file,
  3033.  
  3034. ; 2) The file name (IMPORTANT!!! DO NOT add .info onto the end!!!)
  3035. ;    also, the file doesn't have to have its own icon.
  3036.  
  3037. ; 3) The screen number - therefore, you have to have a screen
  3038. ;    in use, but it can use ANY Intuition screen :)
  3039.  
  3040. ; NOTE : For some reason, the icon information requester
  3041. ;        still pops up if you give it a non-existent file!
  3042.  
  3043. Statement ShowInfo {dir$,icon$,skreen.b}
  3044.  
  3045.   *scr.Screen=Peek.l(Addr Screen(skreen)) ; get screen structure for wbinfo_() call
  3046.  
  3047.   *lok.l=Lock_(&dir$,#ACCESS_READ) ; get a lock on the directory for the call
  3048.  
  3049.   If *scr ; make sure we've got a screen structure
  3050.     If *lok ; and a directory lock
  3051.       If WBInfo_(*lok,&icon$,*scr) ; the Icon Info call!
  3052.       Else Request "","Error showing icon information!","Oh..."
  3053.       EndIf
  3054.   UnLock_ *lok ; free our directory lock
  3055.   Else Request "","Couldn't get lock on directory!","Oh..."
  3056.   EndIf
  3057.   Else Request "","Doh!||The programmer has asked for a non-existent screen!","Duh..."
  3058.   EndIf
  3059.  
  3060. End Statement
  3061.  
  3062. ; demo :
  3063.  
  3064. ; WBenchToFront_ : FindScreen 0 ; needed for requester
  3065. ; ShowInfo {"c:","copy",0}
  3066. ; End
  3067.  
  3068. ;-----------------------------------------------------------------
  3069.  
  3070. ; Function : StripFile { path & file name }
  3071.  
  3072. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3073.  
  3074. ; Returns the file part of a path & file string,eg from a
  3075. ; reqtools file requester or an appicon.
  3076.  
  3077. Function.s StripFile{p$}
  3078.  
  3079. *fileptr.l = FilePart_(&p$)
  3080. f$=Peek$(*fileptr)
  3081.  
  3082. Function Return f$
  3083. End Function
  3084.  
  3085. ; demo :
  3086.  
  3087. ; MaxLen f$=192 ; needed for RTEZLoadFile
  3088. ; FindScreen 0  ; same here
  3089.  
  3090. ; a$=RTEZLoadFile("Select file",f$)
  3091. ; If a$="" Then End
  3092.  
  3093. ; Request "","The file part of "+a$+"|is : "+StripFile{a$},"OK"
  3094. ; End
  3095.  
  3096. ;-----------------------------------------------------------------
  3097.  
  3098. ; Function : CreateDir { new directory }
  3099.  
  3100. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3101.  
  3102. ; Tries to create a new directory. You have to supply the full
  3103. ; path name of the directory you want to create.
  3104.  
  3105. ; Returns False (0) for a failure (try doing Exists() on the
  3106. ; directory you're trying to create - it may already exist.
  3107.  
  3108. Function.l CreateDir{dir$}
  3109.  
  3110.   *lock.l = CreateDir_(&dir$)
  3111.  
  3112.   If *lock
  3113.     UnLock_ *lock
  3114.   EndIf
  3115.  
  3116. Function Return *lock
  3117. End Function
  3118.  
  3119. ; demo :
  3120.  
  3121. ; If CreateDir{"Ram:Test"}
  3122. ;   NPrint "New drawer created!"
  3123. ; Else NPrint "Failed to create new drawer..."
  3124. ;   If Exists ("Ram:Test") Then NPrint "Drawer already exists!"
  3125. ; EndIf
  3126.  
  3127. ; End
  3128.  
  3129. ;-----------------------------------------------------------------
  3130.  
  3131. ; Function : CheckLib { library, version }
  3132.  
  3133. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3134. ; copied from suggestion by Paul Burkey ;)
  3135.  
  3136. ; Minor bugfix (was harmless) - changed OpenLibrary_() result's
  3137. ; type to .Library instead of .l, which is how it's meant to be!
  3138.  
  3139. ; Checks library versions.
  3140.  
  3141. ; Throw it at the start of your code,then do :
  3142.  
  3143. ;   getit.Library=CheckLib {"some.library",version}
  3144.  
  3145. ; ...where "some.library" is the library you need to check for,
  3146. ; and version is the version number you need (0 if it doesn't
  3147. ; matter)...
  3148.  
  3149. ; It returns True (-1) for success, False (0) for fail...duh... ;)
  3150.  
  3151. ; NOTE : Don't use subversions for the version number -
  3152. ; you can only use integers (this is an OS rule, not mine!),
  3153. ; eg for madeup.library v2.21 you would call :
  3154.  
  3155. ; x.Library = CheckLib {"madeup.library",2}
  3156.  
  3157. ; Just repeat that call for each library you need.
  3158.  
  3159. ; Use SnoopDos to see if your program requires a particular
  3160. ; version,otherwise you can usually just use 0.
  3161.  
  3162. Function.b CheckLib {lib$,libv.w}
  3163.  
  3164.   *lib.Library=OpenLibrary_(&lib$,libv)
  3165.  
  3166.   If *lib
  3167.     CloseLibrary_ *lib
  3168.     Function Return -1
  3169.   Else Function Return 0
  3170.   EndIf
  3171.  
  3172. End Function
  3173.  
  3174. ; demo :
  3175.  
  3176. ; lib$="reqtools.library" ; library to check for,
  3177. ; libv.b=38               ; version number needed.
  3178.  
  3179. ; If CheckLib {lib$,libv}=0 Then Request "ERROR!","You need "+lib$+" v"+Str$(libv)+"!","Abort":End
  3180.  
  3181. ; End
  3182.  
  3183. ;-----------------------------------------------------------------
  3184.  
  3185. ; Function : OSAssign { assign name, path, type }
  3186.  
  3187. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3188.  
  3189. ; This function creates an assign and returns True if
  3190. ; successful, false if not.
  3191.  
  3192. ; The parameters are the assign name (eg. "MyAss:"), the
  3193. ; path which this assign refers to (eg. "Work:Gfx/Pics"),
  3194. ; and the type of assign - True (-1) for Path, or False (0)
  3195. ; for a Late assign.
  3196.  
  3197. ; Path assigns are activated immediately, Late assigns
  3198. ; only activate when you try to use them (saves clogging
  3199. ; up file/path requesters for a start :)
  3200.  
  3201. ; I've called it OSAssign to avoid confusion with the BSS command
  3202. ; Assign.
  3203.  
  3204. ; Also, the function checks for the existence of the path
  3205. ; you specify, since you CAN assign a name to a non-existent
  3206. ; drawer! It returns False (0) if the path doesn't exist.
  3207.  
  3208. ; Sore Point : Don't know how to remove it, except for :
  3209.  
  3210. ;   Execute_ "run >NIL: assign <assign> REMOVE",0,0
  3211.  
  3212. Function.b OSAssign {name$,path$,PathOrLate.b}
  3213.  
  3214. If Exists(path$)
  3215.  
  3216.   Select PathOrLate
  3217.  
  3218.     Case 0 ; LATE assign...starts when accessed.
  3219.  
  3220.       If AssignLate_(&name$,&path$)
  3221.         Function Return -1
  3222.       Else Function Return 0
  3223.       EndIf
  3224.  
  3225.     Case -1 ; PATH assign...starts immediately.
  3226.  
  3227.       If AssignPath_(&name$,&path$)
  3228.         Function Return -1
  3229.       Else Function Return 0
  3230.       EndIf
  3231.  
  3232.   Default
  3233.       Function Return 0
  3234.   End Select
  3235.  
  3236. Else Function Return 0
  3237. EndIf
  3238.  
  3239. End Function
  3240.  
  3241. ; demo :
  3242.  
  3243. ;; NOTE : To remove the assign after testing, go to the CLI and
  3244. ;; type "assign MyAss: REMOVE" (without the quotes!).
  3245.  
  3246. ; If OSAssign {"MyAss","SYS:C/",-1} ; -1=path assign...
  3247. ;   Request "","Success! MyAss: is assigned to the SYS:C/ drawer!","OK"
  3248. ; Else Request "","Couldn't assign MyAss: !","OK"
  3249. ; EndIf
  3250.  
  3251. ; End
  3252.  
  3253. ;-----------------------------------------------------------------
  3254.  
  3255. ; Function : Del { file }
  3256.  
  3257. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3258.  
  3259. ; Deletes a file, returning True (-1) for success, False (0)
  3260. ; for failure to delete.
  3261.  
  3262. Function.b Del {f$}
  3263.  
  3264.   If DeleteFile_ (&f$)
  3265.     Function Return -1
  3266.   Else Function Return 0
  3267.   EndIf
  3268.  
  3269. End Function
  3270.  
  3271. ; demo :
  3272.  
  3273. ;; NOTE : Change the filename before running this demo!
  3274.  
  3275. ; If Del {"RAM:MadeUpFile.iff"}
  3276. ;   Request "","Deleted!","OK"
  3277. ; Else Request "","Couldn't delete file!","OK"
  3278. ; EndIf
  3279.  
  3280. ; End
  3281.  
  3282. ;-----------------------------------------------------------------
  3283.  
  3284. ; Function : OpenShell { x, y, width, height, title, flag(s) }
  3285.  
  3286. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3287.  
  3288. ; This function opens a full CLI window for your user to
  3289. ; do their stuff (deleting/copying files, anything a normal shell
  3290. ; can do).
  3291.  
  3292. ; Program flow is halted until the user closes the shell window,
  3293. ; either by clicking on the close gadget (if available) or by
  3294. ; typing "endcli".
  3295.  
  3296. ; See the error codes and demo to check whether the shell
  3297. ; function was a success.
  3298.  
  3299. ; You don't really need to check as much as in the demo;
  3300. ; just check if OpenShell{}=-1 (successful).
  3301.  
  3302. ; Note that the width and height aren't too important - the
  3303. ; window will be made to fit the screen if you give parameters
  3304. ; which are too large.
  3305.  
  3306. ; I didn't check the freeing of the console memory (Close_()),
  3307. ; as there's not much you can do if it doesn't free it!
  3308.  
  3309. Function.b OpenShell {x.w,y.w,w.w,h.w,title$,flag$}
  3310.  
  3311. win$="CON:"+Str$(x)+"/"+Str$(y)+"/"+Str$(w)+"/"+Str$(h)+"/"+title$+"/"+UCase$(flag$)
  3312.  
  3313.   ; Error codes returned :
  3314.   ; ----------------------
  3315.   ; -1 = Success.
  3316.   ;  0 = Failed to setup console.
  3317.   ;  1 = Failed to create shell from console.
  3318.   ;  2 = Failed to create shell,      failed to close console.
  3319.   ;  3 = Succeeded in creating shell, failed to close console.
  3320.  
  3321.   ; What it checks for :
  3322.   ; --------------------
  3323.   ; Did it create the console window?
  3324.   ; Did it turn the console window into a shell?
  3325.   ; Did it close the console?
  3326.   ; Combinations of these...
  3327.  
  3328.   ; Possible Flags :
  3329.   ; ----------------
  3330.  
  3331.   ; (Some of these won't do anything - they are for use on
  3332.   ;  non-Shell console windows, eg. information consoles.)
  3333.  
  3334.   ; Flags are separated by a slash / and can be combined...
  3335.  
  3336.   ; ALT   - adds a zoom gadget and sets the "zoomed" size :
  3337.  
  3338.   ;         Format : ALTx/y/width/height (NOTE - no space
  3339.   ;         between ALT and the first number!)
  3340.  
  3341.   ;         eg. ALT20/20/300/100
  3342.  
  3343.   ; Others (these descriptions are pretty much the same as
  3344.   ; Blitz window flags) :
  3345.  
  3346.   ; CLOSE/BACKDROP/INACTIVE/NOBORDER/NOCLOSE/NODEPTH/NODRAG
  3347.   ; NOSIZE/SCREEN/SIMPLE (Default)/SMART/WAIT/AUTO
  3348.  
  3349.   ; NOTES : NOBORDER leaves the right-hand border and part
  3350.   ; of the top for some reason!
  3351.  
  3352.   ; SCREEN - supply the name of the screen to open the window
  3353.   ; on, after the SCREEN keyword...eg. CLOSE/SCREEN MadeupScreen/SMART
  3354.  
  3355.   ; SIMPLE - default : text resizes to fit in shrunken/
  3356.   ; expanded window.
  3357.  
  3358.   ; SMART - text doesn't resize.
  3359.  
  3360.   ; WAIT - will only close via close gadget or Ctrl-\
  3361.  
  3362.   ; No use in a Shell window.
  3363.  
  3364. *fh.l=Open_(&win$,#MODE_READWRITE)
  3365.  
  3366. If *fh
  3367.  
  3368.   If Execute_ ("",*fh,0)=0 ; failure to create shell :
  3369.  
  3370.     If Close_ (*fh)=0
  3371.       Function Return 2 ; failed to create shell AND close console
  3372.     Else Function Return 1 ; failed to create shell from console
  3373.     EndIf
  3374.  
  3375.   Else
  3376.     If Close_ (*fh)=0
  3377.       Function Return 3 ; succeeded in creating shell, failed to close console
  3378.     Else Function Return -1 ; TOTAL SUCCESS :)
  3379.     EndIf
  3380.  
  3381.   EndIf
  3382.  
  3383. Else Function Return 0 ; failed to setup console
  3384. EndIf
  3385.  
  3386. End Function
  3387.  
  3388. ; demo :
  3389.  
  3390. ;   result.b=OpenShell{0,50,640,100,"Hello, I'm a CLI!","CLOSE/ALT30/30/100/100"}
  3391.  
  3392. ; Select result
  3393. ;   Case -1
  3394. ;     error$="Shell function was a success!"
  3395. ;   Case 0
  3396. ;     error$="Failed to setup console window!"
  3397. ;   Case 1
  3398. ;     error$="Failed to create shell from console!"
  3399. ;   Case 2
  3400. ;     error$="Opened console|Failed to create shell|Can't close console!"
  3401. ;   Case 3
  3402. ;     error$="Succeeded in creating shell|Couldn't close shell window!"
  3403. ; End Select
  3404.  
  3405. ; Request "",error$,"OK"
  3406. ; End
  3407.  
  3408. ;-----------------------------------------------------------------
  3409.  
  3410. ; Function : Name { old file name, new name for file }
  3411.  
  3412. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3413.  
  3414. ; This function tries to rename a file to the new name,
  3415. ; returning True (-1) for success, False (0) for failure.
  3416.  
  3417. Function.b Name {old$,new$}
  3418.  
  3419.   If Rename_ (&old$,&new$)
  3420.     Function Return -1
  3421.   Else Function Return 0
  3422.   EndIf
  3423.  
  3424. End Function
  3425.  
  3426. ; demo :
  3427.  
  3428. ;; IMPORTANT!!! Change the path/file to ones on your system!
  3429.  
  3430. ;; Choose unimportant ones to save too much hassle!
  3431.  
  3432. ; If Name {"Stuff:temp/pic.iff","Stuff:temp/pix.iff"}=0
  3433. ;   Request "","Couldn't rename file!","OK"
  3434. ; EndIf
  3435. ; End
  3436.  
  3437. ;-----------------------------------------------------------------
  3438.  
  3439. ; Function : FileTime { filename }
  3440.  
  3441. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3442.  
  3443. ; Returns a string containing the time the file was created.
  3444. ; Useful with FileDate.
  3445.  
  3446. Function.s FileTime {f$}
  3447.   lock.l=Lock_(&f$,#ACCESS_READ)
  3448.   If lock
  3449.     DEFTYPE .FileInfoBlock fib
  3450.       If Examine_(lock, fib) <> 0
  3451.         *date.DateStamp=&fib\fib_Date
  3452.         time.l=*date\ds_Minute ; minutes past midnight
  3453.         hrs.w=time/60
  3454.         mns.w=time-(hrs*60)
  3455.  
  3456.         time$+Right$("0"+Str$(hrs),2)+":"           ; hours
  3457.         time$+Right$("0"+Str$(mns),2)+":"           ; minutes
  3458.         time$+Right$("0"+Str$(*date\ds_Tick/50),2)  ; seconds
  3459.       Else time$=""
  3460.       EndIf
  3461.       UnLock_ lock
  3462.   Else time$=""
  3463.   EndIf
  3464. Function Return time$
  3465. End Function
  3466.  
  3467. ; demo :
  3468.  
  3469. ; FindScreen 0
  3470.  
  3471. ; f$="SYS:Utilities/Multiview"
  3472.  
  3473. ; Request "","File modification time for :||"+f$+" :||"+FileTime{f$},"OK"
  3474. ; End
  3475.  
  3476. ;-----------------------------------------------------------------
  3477.  
  3478. ; Function : FileDate { filename }
  3479.  
  3480. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3481.  
  3482. ; Returns "Last modified" date of a file as a string.
  3483.  
  3484. ; See manual for Date$ and DateFormat entries (page 119 for
  3485. ; Blitz 2) for formatting options.
  3486.  
  3487. Function.s FileDate {f$}
  3488.  
  3489. lock.l=Lock_(&f$,#ACCESS_READ)
  3490.  
  3491. If lock
  3492.  
  3493. DEFTYPE .FileInfoBlock fib
  3494.  
  3495. If Examine_(lock, fib) <> 0
  3496.   *date.DateStamp=&fib\fib_Date
  3497.   dt$=Date$(*date\ds_Days)
  3498. Else dt$=""
  3499. EndIf
  3500.  
  3501. UnLock_ lock
  3502.  
  3503. Else dt$=""
  3504. EndIf
  3505.  
  3506. Function Return dt$
  3507. End Function
  3508.  
  3509. ; demo :
  3510.  
  3511. ; f$="SYS:Utilities/Multiview"
  3512.  
  3513. ; d$=FileDate{f$}
  3514.  
  3515. ; Request "","Last modification date of :||"+f$+" :||"+d$+".","OK"
  3516. ; End
  3517.  
  3518. ;-----------------------------------------------------------------
  3519.  
  3520. ; Function : SetComment { filename, comment }
  3521.  
  3522. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3523.  
  3524. ; Tries to write a file comment to the specified file.
  3525.  
  3526. ; (The comment appears in the Comment section when you look
  3527. ; at a file's icon using the Icon/Information menu item
  3528. ; from Workbench.)
  3529.  
  3530. ; Returns True (-1) if it's successful,False (0) if it fails.
  3531.  
  3532. Function.l SetComment{fname$,comment$}
  3533.   a.l=SetComment_ (&fname$,&comment$)
  3534. Function Return a
  3535. End Function
  3536.  
  3537. ; demo :
  3538.  
  3539. ; filename$="ram:t" ; adds a comment to the Ram:T drawer
  3540.  
  3541. ; If SetComment{filename$,"Hello,I'm a comment!"}=-1
  3542. ;  Request "","Done it! Now click on the file's icon|and go to the WB Icons/Information menu...","OK"
  3543. ;  Else Request "","Failed to write comment!","Doh!"
  3544. ; EndIf
  3545.  
  3546. ; End
  3547.  
  3548. ;-----------------------------------------------------------------
  3549.  
  3550. ; Function : ReadComment { filename }
  3551.  
  3552. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3553.  
  3554. ; Reads the file comment of the file/drawer you specify.
  3555.  
  3556. ; Note that you can check for Lock_ and Examine_ failures
  3557. ; by uncommenting the appropriate lines in the function itself,
  3558. ; otherwise it just returns "".
  3559.  
  3560. Function.s ReadComment {f$}
  3561.  
  3562. lock.l=Lock_(&f$,#ACCESS_READ)
  3563.  
  3564. If lock
  3565.  
  3566. DEFTYPE .FileInfoBlock fib
  3567.  
  3568.   If Examine_(lock, fib) <> 0
  3569.     comment$=Peek$(&fib\fib_Comment)
  3570. ; Else comment$="Failed to examine file"
  3571. ; ^ Uncomment if you want to check for failure instead of returning ""
  3572.  
  3573.   EndIf
  3574.  
  3575.   UnLock_ lock
  3576.  
  3577. ; Else comment$="Lock failure"
  3578. ; ^ Uncomment if you want to check for failure instead of returning ""
  3579.  
  3580. EndIf
  3581.  
  3582. Function Return comment$
  3583.  
  3584. End Function
  3585.  
  3586. ; demo :
  3587.  
  3588. ;; WARNING!!! Demo uses the SetComment {} function above!
  3589.  
  3590. ;; After running, click on the file and choose Information
  3591. ;; from the Workbench menus.
  3592.  
  3593. ; fl$="RAM:T/" ; file to set/read comment on...
  3594.  
  3595. ; If SetComment {fl$,"Hello, I'm a comment!"}
  3596. ;   comment$=ReadComment {fl$}
  3597. ;   Request "","Comment for file : ||"+fl$+"||"+Chr$(34)+comment$+Chr$(34),"OK"
  3598. ; Else Request "","Failed to set comment!","Doh!"
  3599. ; EndIf
  3600.  
  3601. ; End
  3602.  
  3603. ;-----------------------------------------------------------------
  3604.  
  3605. ; Function : Exist { filename }
  3606.  
  3607. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3608.  
  3609. ; NOTE : This function replaces the IsThere {} function,
  3610. ;        since IsThere {} only told you if the file was there.
  3611.  
  3612. ; Full replacement for Exists(), but uses OS functions to return
  3613. ; file size.
  3614.  
  3615. ; Return values :
  3616.  
  3617. ; (size) - if none of the below, it's the file's size!
  3618. ;  0 - can't get a lock (read : file isn't there)
  3619. ; -1 - file is a directory or disk (same as Exists returns)
  3620. ; -2 - got lock but couldn't get size (Examine_ failed - rare!)
  3621.  
  3622. ; This will reduce the size of an executable as well as the fact
  3623. ; that Exists keeps a file locked until the program ends,
  3624. ; meaning you can't delete it or perform some other operations
  3625. ; on it :
  3626.  
  3627. ; eg. This won't delete the file :
  3628.  
  3629. ; If Exists("SYS:multiview")
  3630. ;   DeleteFile_ "sys:multiview" ; uh-uh - file's
  3631. ; EndIf                         ; locked by Exists!
  3632.  
  3633. ; But this will :
  3634.  
  3635. ; If Exist {"SYS:multiview"}
  3636. ;   DeleteFile_ "sys:multiview"
  3637. ; EndIf
  3638.  
  3639. Function.l Exist {f$}
  3640.  
  3641. lock.l=Lock_(&f$,#ACCESS_READ)
  3642.  
  3643. If lock
  3644.  
  3645. DEFTYPE .FileInfoBlock fib
  3646.  
  3647. If Examine_(lock, fib) <> 0
  3648.  
  3649.   If fib\fib_DirEntryType < 0
  3650.     size=Peek.l(&fib\fib_Size)  ; file
  3651.   Else size=-1                  ; drawer
  3652.   EndIf
  3653.  
  3654.   Else size=-2 ; failed to examine file! rare occurence!
  3655. EndIf
  3656.  
  3657. UnLock_ lock
  3658. Else size=0 ; failed to lock file (doesn't exist basically)...
  3659. EndIf
  3660.  
  3661. Function Return size
  3662.  
  3663. End Function
  3664.  
  3665. ; demo :
  3666.  
  3667. ; f$="SYS:Utilities/Multiview"
  3668.  
  3669. ; bytes.l=Exist {f$}
  3670.  
  3671. ; Request "","Size of :||"+f$+"||is "+Str$(bytes)+" bytes.","OK"
  3672. ; End
  3673.  
  3674. ;-----------------------------------------------------------------
  3675.  
  3676. ; Function : CompareDates { file 1, file 2 }
  3677.  
  3678. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3679.  
  3680. ; UPDATED to use OS function CompareDates ()
  3681.  
  3682. ; Compares the dates of two files, and tells you if the
  3683. ; first is older than or newer than (or the same age as) the
  3684. ; second.
  3685.  
  3686. ; Because CompareDates_ (the OS function) can return
  3687. ; any value (0, greater than 0, or less than 0), I had
  3688. ; to return a specific value on "failure to examine/lock"
  3689. ; a file.
  3690.  
  3691. ; I chose -999 since it's reasonably easy to remember, and
  3692. ; I suppose the chances are slim that the function will
  3693. ; return that exact value (though knowing my luck... ;)
  3694.  
  3695. ; It means that you should check for -999 to see if it failed,
  3696. ; and skip the display of relative ages if you get it...
  3697.  
  3698. ; Also, I discovered that you can't use Select...End Select,
  3699. ; because it doesn't like being given "Case <0" / "Case >0" ;)
  3700.  
  3701. Function.l CompareDates {f1$,f2$}
  3702.  
  3703.   Dim *dstamp.DateStamp (2)
  3704.   Dim fib.FileInfoBlock (2)
  3705.  
  3706.   For a=1 To 2
  3707.  
  3708.     If a=1 Then f$=f1$ Else f$=f2$ ; the key to my optimisation ;)
  3709.  
  3710.     lock.l=Lock_(&f$,#ACCESS_READ)
  3711.  
  3712.       If lock
  3713.  
  3714.         If Examine_(lock, fib(a)) <> 0
  3715.           *dstamp(a)=&fib(a)\fib_Date
  3716.         Else UnLock_ lock:Function Return -999
  3717.         EndIf
  3718.  
  3719.         UnLock_ lock
  3720.       Else Function Return -999
  3721.       EndIf
  3722.  
  3723.   Next a
  3724.  
  3725.   result.l=CompareDates_(*dstamp(1),*dstamp(2))
  3726.  
  3727. Function Return result
  3728. End Function
  3729.  
  3730. ; demo :
  3731.  
  3732. ; files to compare :
  3733.  
  3734. ; a$="sys:utilities/multiview"   ; try swapping a$ and b$ over
  3735. ; b$="c:copy"
  3736.  
  3737. ; res.l=CompareDates{a$,b$}
  3738.  
  3739. ; If res=-999
  3740. ;   Request "","Failed to compare dates!","OK"
  3741. ;   End
  3742. ; EndIf
  3743.  
  3744. ; If res=0
  3745. ;   Request "",a$+" and "+b$+" share the same date","OK"
  3746. ; EndIf
  3747.  
  3748. ; If res<0
  3749. ;   Request "",a$+" is newer than "+b$,"OK"
  3750. ; EndIf
  3751.  
  3752. ; If res>0
  3753. ;   Request "",a$+" is older than "+b$,"OK"
  3754. ; EndIf
  3755.  
  3756. ; End
  3757.  
  3758. ;-----------------------------------------------------------------
  3759.  
  3760. ; Function : RunFromWB { program }
  3761.  
  3762. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3763. ; (modified from unknown source)
  3764.  
  3765. ; Tries to run the specified program as if run from the
  3766. ; Workbench via an icon (so it can use its tooltypes, etc).
  3767.  
  3768. ; Returns 0 for failure, -1 (True) for success.
  3769.  
  3770. ; If it fails, just try using Execute_ program$,0,0
  3771.  
  3772. ; ie. something like :
  3773.  
  3774. ;   If RunFromWB {"sys:utilities/multiview"}=0
  3775. ;     Execute_ "run>NIL: sys:utilities/multiview",0,0
  3776. ;   EndIf
  3777.  
  3778. Function.b RunFromWB {prog$}
  3779.  
  3780.   If Exists(prog$+".info")=0
  3781.     Function Return 0
  3782.   EndIf
  3783.  
  3784.   lib$="wbstart.library"
  3785.   libv.l=2
  3786.   *lib.l=OpenLibrary_(&lib$,libv.l)
  3787.  
  3788.   If *lib
  3789.     CloseLibrary_ *lib
  3790.   Else Request "","You need wbstart.library v2!","Abort":End
  3791.   EndIf
  3792.  
  3793.   #WBSTART_VERSION = 2
  3794.   #WBStart_Name =          (#TAG_USER + 1)
  3795.   #WBStart_DirectoryName = (#TAG_USER + 2)
  3796.   #WBStart_DirectoryLock = (#TAG_USER + 3)
  3797.   #WBStart_Stack =         (#TAG_USER + 4)
  3798.   #WBStart_Priority =      (#TAG_USER + 5)
  3799.   #WBStart_ArgumentCount = (#TAG_USER + 6)
  3800.   #WBStart_ArgumentList =  (#TAG_USER + 7)
  3801.  
  3802.   olddir.l = CurrentDir_(0)
  3803.   Dim wbtags.TagItem(20)
  3804.   wbtags(0)\ti_Tag = #WBStart_Name, &prog$
  3805.   wbtags(1)\ti_Tag = #WBStart_DirectoryLock, olddir
  3806.   success.l = WBStartTagList_(&wbtags(0))
  3807.   If success=0 Then success=-1 Else success=0 ; true if ran properly!
  3808.  
  3809. Function Return success
  3810. End Function
  3811.  
  3812. ; demo :
  3813.  
  3814. ; program$="sys:utilities/multiview"
  3815.  
  3816. ; If RunFromWB{program$}
  3817. ; Else Execute_ "run >NIL: "+program$,0,0
  3818. ; EndIf
  3819.  
  3820. ; End
  3821.  
  3822. ;-----------------------------------------------------------------
  3823.  
  3824. ; Function : ShowWhy {}
  3825.  
  3826. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3827.  
  3828. ; Returns a string to explain why a file input/output
  3829. ; operation should have failed - the string comes
  3830. ; directly from the OS...
  3831.  
  3832. ; You can do stuff like :
  3833.  
  3834. ; If Exists("SomeFile.txt")
  3835. ;   Request "","Got it !","OK"
  3836. ; Else Request "",ShowWhy {},"OK"
  3837. ; EndIf
  3838.  
  3839. ; Though to be really safe, you should add another character
  3840. ; in a requester (eg. a full-stop, or period), in case
  3841. ; there's no string for some weird reason - shouldn't happen,
  3842. ; but...
  3843.  
  3844. ; Note, you can change the header$ to whatever suits you,
  3845. ; but remember the OS adds a colon :
  3846.  
  3847. Function$ ShowWhy {}
  3848.  
  3849.   header$="DOS Error "  ; colon : automatically added on...
  3850.   err$=String$(" ",256) ; kludge up a string buffer ;)
  3851.  
  3852.   error.l=IoErr_()      ; find out WTF the problem is...
  3853.  
  3854.   If Fault_ (error,&header$,&err$,256) ; get DOS error string...
  3855.     Function Return err$               ; send it back...
  3856.   EndIf
  3857.  
  3858. End Function
  3859.  
  3860. ; demo :
  3861.  
  3862. ; f$="ram:NoSuchDrawer/"
  3863.  
  3864. ; lock.l=Lock_(&f$,0)
  3865.  
  3866. ; If lock=0
  3867. ;   Request "","Couldn't lock file!||"+ShowWhy {},"OK"
  3868. ; EndIf
  3869.  
  3870. ; End
  3871.  
  3872. ;-----------------------------------------------------------------
  3873.  
  3874. ; Function : SetProtect { file, flags }
  3875.  
  3876. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3877. ; With help from David McMinn :)
  3878.  
  3879. ; Sets file protection flags from Blitz...
  3880. ; Now you can delete those undeleteable files :)
  3881.  
  3882. ; IMPORTANT - YOU MUST follow the demo, reading the text in
  3883. ; there to understand what's going on - this is pretty
  3884. ; awkward, but it's the easiest way I could do it, thanks
  3885. ; to the weird way the protection flags get set...
  3886.  
  3887. Function.b SetProtect{f$, bits.l}
  3888.  
  3889. If SetProtection_(&f$,bits)
  3890.   Function Return -1          ; success
  3891. Else Function Return 0        ; failure
  3892. EndIf
  3893.  
  3894. End Function
  3895.  
  3896. ; demo :
  3897.  
  3898. ;; Don't uncomment until you're told to ;)
  3899.  
  3900. ;; SPA  = Script, Pure, Archive flags.
  3901. ;; RWED = Readable, Writeable, Executable, Deleteable flags.
  3902.  
  3903. ;; This is pretty awkward. basically, if you specify any of the
  3904. ;; SPA bits, they are set and the others (of the SPA) are unset.
  3905.  
  3906. ;; With the RWED bits, any that you specify are UNSET, and
  3907. ;; the other RWED bits are SET (ie the opposite of what happens
  3908. ;; with SPA bits!)
  3909.  
  3910. ;; So to try and make things easier to follow, do it like this;
  3911. ;; first specify which of the SPA bits should be set (separated
  3912. ;; by an | (OR) sign), and then which of the RWED bits should
  3913. ;; be unset, then OR them together...
  3914.  
  3915. ;; Jeez...hopefully, the demo itself will make it easier
  3916. ;; to understand ;)
  3917.  
  3918. ; From memory, these are the available flags you can set :
  3919.  
  3920. ;; #FIBF_SCRIPT
  3921. ;; #FIBF_PURE
  3922. ;; #FIBF_ARCHIVE
  3923. ;; #FIBF_READ
  3924. ;; #FIBF_WRITE
  3925. ;; #FIBF_EXECUTE
  3926. ;; #FIBF_DELETE
  3927.  
  3928. ;;------------------------------
  3929.  
  3930. ;; OK, uncomment from here :
  3931.  
  3932. ; SPAbits.l=#FIBF_ARCHIVE              ; "A" bit set, "SP" *UNSET*
  3933. ; RWEDbits.l=#FIBF_WRITE|#FIBF_DELETE  ; "WD" unset,  "RE" *SET*
  3934.  
  3935. ; bits=SPAbits|RWEDbits                ; combine (OR) them...
  3936.  
  3937. ; f$="ram:amigaboot.txt" ; change to a non-important file
  3938.                          ; on YOUR system!
  3939.  
  3940. ; If SetProtect{f$,bits}
  3941. ;   Request "","Success!","OK"
  3942. ; Else Request "","Failure!","OK"
  3943. ; EndIf
  3944.  
  3945. ; End
  3946.  
  3947. ;; now check the file with the icon information requester
  3948. ;; or shell listing...
  3949.  
  3950. ;-----------------------------------------------------------------
  3951.  
  3952. ; Function : AskForDisk { disk name }
  3953.  
  3954. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  3955.  
  3956. ; *Slightly* experimental, but seems OK!
  3957.  
  3958. ; Checks for the requested disk, and returns :
  3959.  
  3960. ;  1 - if it's missing, and the user cancels the "Insert Disk"
  3961. ;      requester,
  3962. ;  0 - if the disk is write-protected,
  3963. ; -1 - if the disk is write-enabled.
  3964.  
  3965. ; Handy for load - and particularly - save routines :)
  3966.  
  3967. ; You supply the name of the disk (or drive) and also
  3968. ; the "protected-report-value" : -1 (True) or 0 (False).
  3969.  
  3970. ; If you set the report value to -1, it'll give the
  3971. ; "Retry/Cancel" requester if the disk is write-protected
  3972. ; whereas setting report to 0 will suppress this, so you can
  3973. ; just give 'em your "Well, f*** you, then!" message :)
  3974.  
  3975. ; Basically, if it's -1, they get as many chances as they
  3976. ; like to unprotect the disk and try again (or hit Cancel)...
  3977.  
  3978. Function.b AskForDisk {d$,report.b}
  3979.  
  3980.   DEFTYPE.InfoData fi
  3981.  
  3982.   lok.l=Lock_(&d$,#MODE_OLDFILE)
  3983.  
  3984.   If lok
  3985.   begin
  3986.     If Info_(lok,&fi)
  3987.       If fi\id_DiskState=#ID_WRITE_PROTECTED
  3988.         If report
  3989.           If ErrorReport_ (#ERROR_DISK_WRITE_PROTECTED,1,lok,0)=0
  3990.             Goto begin
  3991.           Else UnLock_ lok:Function Return 0 ; write-protected
  3992.           EndIf
  3993.         Else UnLock_ lok:Function Return 0
  3994.         EndIf
  3995.       Else Function Return -1 ; write-enabled
  3996.       EndIf
  3997.     EndIf
  3998.   UnLock_ lok
  3999.   EndIf
  4000.  
  4001. Function Return 1 ; no disk
  4002. End Function
  4003.  
  4004. ; demo :
  4005.  
  4006. ; Try it with protected and unprotected disks, no disks,
  4007. ; and stuff like CD-ROMs, with report set to 0 or -1 for
  4008. ; each, then you'll get the hang of it... ;)
  4009.  
  4010. ; disk$="DF0:"
  4011.  
  4012. ; Select AskForDisk {disk$,-1}  ; -1 : Retry/Cancel if protected
  4013. ;   Case 1
  4014. ;     Request "","You never inserted "+disk$+" !","OK"
  4015. ;   Case 0
  4016. ;     Request "","Volume "+disk$+" is write-protected!","Fail"
  4017. ;   Case -1
  4018. ;     Request "","Volume "+disk$+" is write-enabled!","OK"
  4019. ; End Select
  4020.  
  4021. ; End
  4022.  
  4023. ;-----------------------------------------------------------------
  4024.  
  4025. ; Function : DelIcon { icon }
  4026.  
  4027. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4028.  
  4029. ; Deletes the specified icon. Automatically removes ".info"
  4030. ; from icon name if you supply it (you're not supposed to ;)
  4031.  
  4032. ; This function updates the Workbench screen so that the
  4033. ; icon disappears if it was visible :)
  4034.  
  4035. Function DelIcon {icon$}
  4036.  
  4037.   If Right$(icon$,5)=".info" Then icon$=Left$(icon$,Len(icon$)-5)
  4038.  
  4039.   If DeleteDiskObject_ (&icon$)
  4040.     Function Return -1
  4041.   Else Function Return 0
  4042.   EndIf
  4043.  
  4044. End Function
  4045.  
  4046. ; demo :
  4047.  
  4048. ;; note that if you supplied "test" below instead of "test.info",
  4049. ;; it would still ONLY delete the icon, not the program "test"!
  4050.  
  4051. ;; oh, and it's safe to call even if the icon's not there, or
  4052. ;; if it's a default "Show all files" type of icon.
  4053.  
  4054. ; If DelIcon {"ram:test.info"}      ; ...replace with something on
  4055. ;   Request "","Deleted","OK"       ; YOUR system!
  4056. ; Else Request "","Not deleted","OK"
  4057. ; EndIf
  4058.  
  4059. ; End
  4060.  
  4061. ;; Handy hint : the ShowWhy {} function can tell you why it
  4062. ;; fails to delete the non-existent icon in the demo (or
  4063. ;; any other reason) :
  4064.  
  4065. ;; Replace the "Not deleted" requester text with
  4066. ;; "Not deleted||"+ShowWhy{} to get the DOS error if it fails
  4067. ;; to delete the icon. You'll have to paste both of these
  4068. ;; functions into a separate program in order to test it though.
  4069.  
  4070. ;-----------------------------------------------------------------
  4071. .
  4072. .Memory
  4073.  
  4074. ;----------------------------------------------------------------
  4075.  
  4076. ; These routines deal with memory access or information.
  4077.  
  4078. ;-----------------------------------------------------------------
  4079.  
  4080. ; Current routines :
  4081.  
  4082. ; MemoryFree  { type }
  4083. ; FlushMem    {}
  4084. ; FlushLib    { library[.library] }
  4085.  
  4086. ;-----------------------------------------------------------------
  4087.  
  4088. ; Function : MemoryFree { type }
  4089.  
  4090. ; Author : Carl Read - carl@cybercraft.co.nz
  4091.  
  4092. ; Slight update : renamed it, cos I could never remember
  4093. ; what Memory {} was for ;)
  4094.  
  4095. ; Returns size of largest block of available memory -
  4096. ; use these flags (mostly just use $0, $1, $2, $4, $8000) :
  4097.  
  4098. ; $0      Any type of memory (0)
  4099. ; $1      Public             (1)
  4100. ; $2      Chip               (2)
  4101. ; $4      Fast               (4)
  4102. ; $100    Local              (256)
  4103. ; $200    DMAable            (512)
  4104. ; $400    KickTags           (1024)
  4105. ; $20000  Largest chunk      (131072)
  4106. ; $80000  Total memory       (524288)
  4107.  
  4108. ; Note that you can add them together, eg. to check for
  4109. ; largest single block of Chip RAM, you'd use $2|$20000...
  4110.  
  4111. ; Oh, and you can replace the numbers with the Blitz
  4112. ; constants - I've just forgotten them all and can't
  4113. ; be bothered looking ;)
  4114.  
  4115.  Function.l MemoryFree {flag.l}
  4116.   Function Return AvailMem_(flag)
  4117.  End Function
  4118.  
  4119. ; demo :
  4120.  
  4121. ; NPrint MemoryFree {$2} ; $100 from the table above is Chip mem...
  4122. ; MouseWait:End
  4123.  
  4124. ;-----------------------------------------------------------------
  4125.  
  4126. ; Statement : FlushMem {}
  4127.  
  4128. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4129.  
  4130. ; Same as calling "Avail Flush" from the CLI.
  4131.  
  4132. ; This makes sure your program has as much free memory as
  4133. ; possible before starting, loading files, etc.
  4134.  
  4135. ; Note that some programs don't like having memory flushed at
  4136. ; certain times (this is the same with "Avail Flush" though),
  4137. ; so use sparingly!
  4138.  
  4139. ; Note that there's no need for this to check the return value
  4140. ; - it's ALWAYS zero!
  4141.  
  4142. ; This is the way described in the docs for PoolMem, and
  4143. ; if you run a program called MemPatch (from Aminet), you'll
  4144. ; see that "Avail Flush"  does exactly the same thing ("Avail
  4145. ; Flush" calls this about 10-15 times though, each time, so
  4146. ; maybe you'll want to do that...)
  4147.  
  4148. ; Also, this clears out unused libraries, fonts, etc as well,
  4149. ; because they get freed only when memory's low, and I think
  4150. ; this call makes them believe that's the case...does work
  4151. ; though :)
  4152.  
  4153. Statement FlushMem {}
  4154.   AllocMem_ $7ffffff0,#MEMF_PUBLIC
  4155. End Statement
  4156.  
  4157. ; demo :
  4158.  
  4159. ;; NOTE - if there's not much memory to be freed, you
  4160. ;; sometimes find that you lose a few bytes while your
  4161. ;; program's trying to free the memory, but try running
  4162. ;; and quitting something big, like Voyager, or calling it
  4163. ;; right after you've done a whole load of programming
  4164. ;; (after you've saved your work, obviously!!!), and you
  4165. ;; should see a big difference...
  4166.  
  4167. ; NPrint ""
  4168. ; av1.l=AvailMem_ (#MEMF_PUBLIC)
  4169. ; NPrint "Available memory : ",av1," bytes."
  4170. ; NPrint ""
  4171.  
  4172. ; FlushMem {}
  4173.  
  4174. ; av2.l=AvailMem_ (#MEMF_PUBLIC)
  4175. ; NPrint "Available memory : ",av2," bytes."
  4176. ; NPrint ""
  4177. ; NPrint "Freed ",-(av1-av2)," bytes." ; if printed number's negative, it's used memory!
  4178. ; NPrint ""
  4179. ; NPrint "Click mouse..."
  4180. ; MouseWait:End
  4181.  
  4182. ;-----------------------------------------------------------------
  4183.  
  4184. ; Statement : FlushLib { library[.library] }
  4185.  
  4186. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4187.  
  4188. ; Flushes CLI-specified library from system
  4189. ; if it's not in use.
  4190.  
  4191. ; RemLibrary () doesn't return a value, hence the reason
  4192. ; this is just a straight statement.
  4193.  
  4194. ; Adapted from Krzysztof Cmok's E source.
  4195.  
  4196. ; More for show, really - better to use the FlushMem {}
  4197. ; statement further up - it does the same as "Avail Flush",
  4198. ; which frees all libraries, fonts, etc which aren't in use
  4199. ; automatically. This is just a nice demo of how to do
  4200. ; this kind of thing :)
  4201.  
  4202. Statement FlushLib {library$}
  4203.  
  4204. *exec.ExecBase=Peek.l(4)
  4205. *mylist.List=*exec\LibList ; replace DeviceList with LibList, etc...
  4206.  
  4207.     Forbid_
  4208.       *libnode.Node=FindName_ (*mylist,&library$)
  4209.       If *libnode
  4210.           RemLibrary_ *libnode
  4211.       EndIf
  4212.     Permit_
  4213.  
  4214. End Statement
  4215.  
  4216. ; demo :
  4217.  
  4218. ;; Create as an executable and supply the library
  4219. ;; name (with .library ending, eg "stc.library")
  4220. ;; you want to flush...note that most libraries will
  4221. ;; be in use, but try running a MUI program and calling
  4222. ;; this on some of the MUI libraries  to see it work
  4223. ;; (in XOpa or similar).
  4224.  
  4225. ; If NumPars
  4226. ;   a$=Par$(1)
  4227. ;   FlushLib {a$}
  4228. ; EndIf
  4229.  
  4230. ; End
  4231.  
  4232. ;-----------------------------------------------------------------
  4233.  
  4234. .
  4235. .CLIOnly
  4236.  
  4237. ;----------------------------------------------------------------
  4238.  
  4239. ; These are routines which unfortunately only work in
  4240. ; programs which are run from the CLI. I don't have
  4241. ; versions that work from Workbench-run programs, otherwise
  4242. ; this section wouldn't be here!
  4243.  
  4244. ;-----------------------------------------------------------------
  4245.  
  4246. ; Current routines :
  4247.  
  4248. ; ParentDir   { directory }
  4249. ; CurrentDir  {}
  4250. ; GetArg      {}
  4251. ; SetProgName { new program name }
  4252. ; TextMode    { style }
  4253. ; Echo        { text }
  4254.  
  4255. ;-----------------------------------------------------------------
  4256.  
  4257. ; Function : ParentDir { directory }
  4258.  
  4259. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4260.  
  4261. ; Returns a string with the parent directory of a given
  4262. ; directory.
  4263.  
  4264. ; Only works from CLI-run programs :(
  4265.  
  4266. Function.s ParentDir{dir$}
  4267.  
  4268. *lok.l=Lock_(&dir$,#ACCESS_READ)
  4269.  
  4270. If *lok
  4271. *newlock.l=ParentDir_(*lok)
  4272.  
  4273. If *newlock
  4274. *stringbuffer = AllocMem_(255, 0)
  4275. n.l=NameFromLock_ (*newlock, *stringbuffer, 255)
  4276.  
  4277. If n
  4278.   lockname$=Peek$(*stringbuffer)
  4279.   Function Return lockname$
  4280. EndIf
  4281.  
  4282. UnLock_ (*newlock)
  4283.  
  4284. EndIf
  4285.  
  4286. UnLock_(*lok)
  4287.  
  4288. EndIf
  4289.  
  4290. End Function
  4291.  
  4292. ; demo :
  4293.  
  4294. ; d$="Sys:Devs/DosDrivers"
  4295. ; Print ParentDir{d$}
  4296. ; MouseWait:End
  4297.  
  4298. ;-----------------------------------------------------------------
  4299.  
  4300. ; Function : CurrentDir {}
  4301.  
  4302. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4303.  
  4304. ; Returns a string with the current directory name
  4305. ; only works with CLI-run programs :(
  4306.  
  4307. Function.s CurrentDir{}
  4308.  
  4309. *stringbuffer = AllocMem_(255, 0)
  4310. suc.l=GetCurrentDirName_(*stringbuffer,255)
  4311.  
  4312. If suc
  4313.   cdirname$=Peek$(*stringbuffer)
  4314.   Function Return cdirname$
  4315.   Else Request "Info","Couldn't get current directory name!","Oh..."
  4316. EndIf
  4317.  
  4318. End Function
  4319.  
  4320. ; demo :
  4321.  
  4322. ; a$=CurrentDir{}
  4323.  
  4324. ; Print a$
  4325. ; MouseWait:End
  4326.  
  4327. ;-----------------------------------------------------------------
  4328.  
  4329. ; Function : GetArg {}
  4330.  
  4331. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4332.  
  4333. ; CLI only :(
  4334.  
  4335. ; Returns the parameters supplied to a CLI-run program, like
  4336. ; Par$()...only difference is, that's all you get - the whole
  4337. ; argument string...could be useful as an exec-size saving
  4338. ; function if your program only takes one argument (eg a file-
  4339. ; name, which you could use this for).
  4340.  
  4341. ; Only works from compiled executables!
  4342.  
  4343. Function.s GetArg{}
  4344.   *ptr = GetArgStr_()
  4345.   a$=Peek.s(*ptr)
  4346. Function Return Left$(a$,Peek.l(&a$-4)-1)
  4347. End Function
  4348.  
  4349. ; demo :
  4350.  
  4351. ;; NOTE - You'll have to compile this into an executable
  4352. ;; and run it from the CLI as "<progname> blah-de-blah".
  4353.  
  4354. ; Print GetArg{}
  4355. ; End
  4356.  
  4357. ;-----------------------------------------------------------------
  4358.  
  4359. ; Function : SetProgName { new program name }
  4360.  
  4361. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4362.  
  4363. ; CLI only :(
  4364.  
  4365. ; This function gives your CLI program a new DOS name.
  4366. ; If you look in XOpa, SnoopDOS or similar, you'll see
  4367. ; that even if you run your program named "MadeUp", it can
  4368. ; appear in the system with another name completely.
  4369.  
  4370. ; Useful if your user renames the program file.
  4371.  
  4372. Function SetProgName {name$}
  4373.  
  4374.   If SetProgramName_ (&name$)
  4375.     Function Return -1
  4376.   Else Function Return 0
  4377.   EndIf
  4378.  
  4379. End Function
  4380.  
  4381. ; demo :
  4382.  
  4383. ; If SetProgName {"I'm a little Test Program!"}=0
  4384. ;   Request "","Failed to set new program name!","OK"
  4385. ;   Else Request "","New program name set!|Go look in XOpa or a similar program!","OK"
  4386. ; EndIf
  4387.  
  4388. ; End
  4389.  
  4390. ;-----------------------------------------------------------------
  4391.  
  4392. ; Function : TextMode { style }
  4393.  
  4394. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4395.  
  4396. ; CLI-only :(
  4397.  
  4398. ; Returns a string containing appropriate style tags, so
  4399. ; you can print in Bold, Italic, etc in the shell. Won't
  4400. ; work in windows, but may work with printers (at least the bold
  4401. ; and italic (not the colours!)...
  4402.  
  4403. ; These are only a few of the codes available, but the most
  4404. ; common...
  4405.  
  4406. ; Just call TextMode {} with whatever style you want...
  4407.  
  4408. #ClearAndModesOff=1     ; clear shell window, all modes off
  4409. #ModesOff=2             ; all modes off
  4410. #Bold=3                 ; bold text
  4411. #FirstCol2=4            ; text uses colour 2 (black)
  4412. #Italic=5               ; italic text
  4413. #TextCol0=6             ; text colour 0
  4414. #TextCol1=7             ; text colour 1
  4415. #TextCol2=8             ; text colour 2
  4416. #TextCol3=9             ; text colour 3
  4417. #Underline=10           ; underlined text
  4418. #BackCol0=11            ; background colour 0
  4419. #BackCol1=12            ; background colour 1
  4420. #BackCol2=13            ; background colour 2
  4421. #BackCol3=14            ; background colour 3
  4422. #Inverse=15             ; inverse mode text
  4423. #Invisible=16           ; blue on blue invisible text
  4424.  
  4425. Function$ TextMode {mode.b}
  4426.   Restore codes
  4427.   If mode<1 OR mode>16 Then Function Return ""
  4428.   For a.b=1 To mode
  4429.     Read mode$
  4430.   Next a
  4431.   mode$=Chr$(27)+"["+mode$
  4432.   Function Return mode$
  4433.   codes:
  4434.   Data$ "c","0m","1m","2m","3m","30m","31m","32m","33m","4m","40m","41m","42m","43m","7m",8m
  4435. End Function
  4436.  
  4437. ; demo :
  4438.  
  4439. ;; for long strings, you'll have to "assemble" them on
  4440. ;; separate lines, like this!
  4441.  
  4442. ; a$=TextMode{#TextCol2}+TextMode{#Bold}
  4443. ; a$+"Hello, I'm bold and white!"+TextMode{#ModesOff}
  4444. ; a$+TextMode{#Italic}+"...and I'm not!"
  4445.  
  4446. ; Print a$
  4447. ; MouseWait:End
  4448.  
  4449. ;-----------------------------------------------------------------
  4450.  
  4451. ; Statement : Echo { text }
  4452.  
  4453. ; Author : FreeJack - Free_Jack@gmx.net
  4454.  
  4455. ; Size-saving replacement for print - ONLY FOR USE
  4456. ; IN CLI PROGRAMS! You can't use this in a window!
  4457.  
  4458. Statement Echo {t$}
  4459.   t$+Chr$(10)+Chr$(0)
  4460.   PutStr_ &t$
  4461. End Statement
  4462.  
  4463. ; demo :
  4464.  
  4465. ; Echo {"Hello you."}
  4466. ; MouseWait
  4467. ; End
  4468.  
  4469. ;-----------------------------------------------------------------
  4470. .
  4471. .Versions
  4472.  
  4473. ;----------------------------------------------------------------
  4474.  
  4475. ; These routines egenrally return various versions,
  4476. ; like library versions, Kickstart versions, etc.
  4477.  
  4478. ;-----------------------------------------------------------------
  4479.  
  4480. ; Current routines :
  4481.  
  4482. ; KSVersion     {}
  4483. ; KickVersion   {}
  4484. ; WBVersion     {}
  4485. ; LibVersion    { library }
  4486.  
  4487. ;-----------------------------------------------------------------
  4488.  
  4489. ; Function : KSVersion {}
  4490.  
  4491. ; Author : Andreas Falkenhahn - Andreas.Falkenhahn@gmx.de
  4492.  
  4493. ; Returns version/revision number of user's Kickstart.
  4494. ; Alternative : see KickVersion {}
  4495.  
  4496. ; Update - minor bugfix - it used to try and free the
  4497. ; memory vector after returning, so it wasn't freeing it.
  4498. ; Also, added check for successful allocation.
  4499.  
  4500. Function KSVersion {}
  4501.  
  4502.   *buf.b=AllocVec_(8,$10001)
  4503.  
  4504.   If *buf
  4505.     ver$="Kickstart"
  4506.     GetVar_ &ver$,*buf,7,0
  4507.     *tbuf.b=*buf
  4508.     FreeVec_ *buf
  4509.   Function Return Val(Peek$(*tbuf))
  4510.   EndIf
  4511.  
  4512. End Function
  4513.  
  4514. ; demo :
  4515.  
  4516. ; NPrint "Kickstart : ",KSVersion {}
  4517. ; MouseWait:End
  4518.  
  4519. ;-----------------------------------------------------------------
  4520.  
  4521. ; Function : KickVersion {}
  4522.  
  4523. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4524.  
  4525. ; Returns exec.library version, like ExecVersion.
  4526.  
  4527. ; Alternative : see KSVersion {}.
  4528.  
  4529. Function.w KickVersion {}
  4530.   e$="exec.library"
  4531.   *lib.Library=OpenLibrary_(&e$,33)
  4532.  
  4533.   If *lib
  4534.     v.w=*lib\lib_Version
  4535.   CloseLibrary_ *lib
  4536.   EndIf
  4537.   Function Return v
  4538. End Function
  4539.  
  4540. ; demo :
  4541.  
  4542. ; NPrint "Kickstart version : ",KickVersion{}
  4543. ; MouseWait
  4544.  
  4545. ; End
  4546.  
  4547. ;-----------------------------------------------------------------
  4548.  
  4549. ; Function : WBVersion {}
  4550.  
  4551. ; Author : Andreas Falkenhahn - Andreas.Falkenhahn@gmx.de
  4552.  
  4553. ; Returns version/revision number of user's Workbench.
  4554.  
  4555. Function WBVersion {}
  4556.  
  4557.   *buf.b=AllocVec_(8,$10001)
  4558.     ver$="Workbench"
  4559.     GetVar_ &ver$,*buf,7,0
  4560.       Function Return Val(Peek$(*buf))  ; -> version is stored in *buf
  4561.     FreeVec_ *buf
  4562.  
  4563. End Function
  4564.  
  4565. ; demo :
  4566.  
  4567. ; NPrint "Workbench : ",WBVersion {}
  4568. ; MouseWait:End
  4569.  
  4570. ;-----------------------------------------------------------------
  4571.  
  4572. ; Function : LibVersion { library }
  4573.  
  4574. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4575.  
  4576. ; Returns the version number of the requested library (must
  4577. ; have full name ("example.library")).
  4578.  
  4579. ; Didn't bother returning revision, since you can't use
  4580. ; it for anything anyway (OpenLibrary_() only takes the
  4581. ; version number)...
  4582.  
  4583. ; NOTE - returns -1 if the library isn't on the user's system.
  4584.  
  4585. Function.w LibVersion {lib$}
  4586.  
  4587.   *lib.Library=OpenLibrary_(&lib$,0)
  4588.  
  4589.   If *lib
  4590.     version.w=*lib\lib_Version
  4591.   Else version=-1
  4592.   EndIf
  4593.  
  4594. Function Return version
  4595.  
  4596. End Function
  4597.  
  4598. ; demo :
  4599.  
  4600. ; NPrint LibVersion {"reqtools.library"}
  4601. ; MouseWait:End
  4602.  
  4603. ;-----------------------------------------------------------------
  4604. .
  4605. .Signals
  4606.  
  4607. ;----------------------------------------------------------------
  4608.  
  4609. ; These routines deal with sending and receiving various
  4610. ; intuition/ARexx signals.
  4611.  
  4612. ;-----------------------------------------------------------------
  4613.  
  4614. ; Current routines :
  4615.  
  4616. ; SendARexx       { arexx command }
  4617. ; TimerWait       { seconds, microseconds }
  4618. ; ReceiveCtrlC    {}
  4619. ; SignalTask      { taskname, signal }
  4620. ; WaitForSignal   { signal }
  4621.  
  4622. ;-----------------------------------------------------------------
  4623.  
  4624. ; Function : SendARexx { arexx command }
  4625.  
  4626. ; Author : Dave Newton
  4627.  
  4628. ; Sends a given ARexx command to a given port.
  4629.  
  4630. ; I'm not gonna pretend to understand ARexx fully, but
  4631. ; as far as I'm aware, this returns either the "reply
  4632. ; message" from the port you sent the command to,
  4633. ; or if an error occurred, an error string.
  4634.  
  4635. ; Supposedly returns even if you supply a non-existent
  4636. ; port, so should work just nicely :)
  4637.  
  4638. ; The demo is from the original source.
  4639.  
  4640. Function.s SendARexx{comm$}
  4641.  
  4642.   *rport.MsgPort=CreateMsgPort(""):okay$="ERROR:-1"
  4643.   If *rport<>0
  4644.     *rmsg.RexxMsg=CreateRexxMsg(*rport,"","")
  4645.     If *rmsg<>0
  4646.       Forbid_                   ;must forbid as rexx port could go without replying!!!!
  4647.       If FindPort_("REXX")<>0
  4648.         SendRexxCommand *rmsg,comm$,#RXCOMM|#RXFF_RESULT|#RXFF_NOIO|#RXFF_STRING
  4649.         Permit_:WaitPort_ *rport:*rmsg=GetMsg_(*rport)      ;give os multitasking back as soon as possible
  4650.         If (*rmsg\rm_Result1=0)&(*rmsg\rm_Result2<>0)
  4651.           okay$=Peek$(*rmsg\rm_Result2)
  4652.         Else
  4653.           okay$="ERROR:"+Str$(*rmsg\rm_Result1)+"-"+Str$(*rmsg\rm_Result2)
  4654.         EndIf
  4655.         ClearRexxMsg *rmsg:DeleteRexxMsg *rmsg
  4656.       EndIf
  4657.     Else
  4658.       Permit_                   ;give task switching back if no rexx port
  4659.     EndIf
  4660.     DeleteMsgPort *rport
  4661.   EndIf
  4662.   Function Return okay$
  4663. End Function
  4664.  
  4665. ; demo :
  4666.  
  4667. ;; NOTE : this demo checks for Multiview's port,
  4668. ;; and sends a message to open a new file...so run
  4669. ;; multiview first!
  4670.  
  4671. ;; You should get a file requester, which loads
  4672. ;; a file into the open copy of multiview.
  4673.  
  4674. ;; If there's more than one copy of multiview running,
  4675. ;; other copies will have names like Multiview.2, Multiview.3,
  4676. ;; and so on.
  4677.  
  4678. ; a$=SendARexx{"Address Multiview.1 OPEN"}
  4679.  
  4680. ; Print a$
  4681.  
  4682. ;; I don't understand the error codes - this works, but returns
  4683. ;; a$ as "Error 0-0" !
  4684.  
  4685. ; End
  4686.  
  4687. ;-----------------------------------------------------------------
  4688.  
  4689. ; Function : TimerWait { seconds, microseconds }
  4690.  
  4691. ; Author : taken from Andrea Doimo's BlitzFAQ website...
  4692. ;          - various authors contributed, so unknown...
  4693.  
  4694. ; Sets up the timer.device to wait for set amount of
  4695. ; time in seconds and microseconds (1/1,000,000 secs).
  4696.  
  4697. ; So a half-second wait would be TimerWait {0,500000},
  4698. ; 1.2 seconds would be TimerWait {1,200000}, etc.
  4699.  
  4700. ; Returned values :
  4701.  
  4702. ; 0 = No error
  4703. ; 1 = Failed to open timer.device
  4704. ; 2 = Failed to open message port
  4705. ; 3 = Failed to create a timer request
  4706.  
  4707. ; There's not much you can do if it fails, so just
  4708. ; use ** If TimerWait {s,m}=0 Then Print "Fail" **
  4709. ; or ** dummy.b=TimerWait {s,m} ** or whatever.
  4710.  
  4711. ; I don't think much can fail though.
  4712.  
  4713. Function.b TimerWait {sec.l, mic.l}
  4714.  
  4715. *TimerMP.MsgPort = CreateMsgPort_()
  4716. If *TimerMP
  4717.   *TimerIO.timerequest = CreateIORequest_ (*TimerMP,SizeOf .timerequest)
  4718.   If *TimerIO
  4719.     err = OpenDevice_ ("timer.device",#UNIT_MICROHZ,*TimerIO,0)
  4720.     If err Then Function Return 1
  4721.     *TimerIO\tr_node\io_Command = #TR_ADDREQUEST
  4722.     *TimerIO\tr_time\tv_secs = sec
  4723.     *TimerIO\tr_time\tv_micro = mic
  4724.     SendIO_ *TimerIO
  4725.     WaitPort_ *TimerMP
  4726.     Repeat
  4727.       *TimerMsg.Message = GetMsg_(*TimerMP)
  4728.     Until *TimerMsg = 0
  4729.     CloseDevice_ (*TimerIO)
  4730.     DeleteIORequest_ (*TimerIO)
  4731.     DeleteMsgPort_ (*TimerMP)
  4732.     Function Return 0
  4733.   Else
  4734.     Function Return 3
  4735.   EndIf
  4736. Else Function Return 2
  4737. EndIf
  4738.  
  4739. End Function
  4740.  
  4741. ; demo :
  4742.  
  4743. ; NPrint "Counting to five..."
  4744. ; NPrint ""
  4745.  
  4746. ; For a=1 To 5
  4747.  
  4748. ;;  Wait one second each time :
  4749. ;   If TimerWait {1,0}<>0 Then Request "","Failed!","OK"
  4750.  
  4751. ; NPrint " ",a
  4752. ; Next a
  4753.  
  4754. ; dummy.b=TimerWait {1,0} ; pause for a second...
  4755. ; End
  4756.  
  4757. ;-----------------------------------------------------------------
  4758.  
  4759. ; Function : ReceiveCtrlC {}
  4760.  
  4761. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4762.  
  4763. ; Update : Thanks to David McMinn for pointing out that the
  4764. ; CtrlC {} statement used to set this up previously was
  4765. ; totally pointless!
  4766.  
  4767. ; Captures Ctrl-C messages sent to the program from either
  4768. ; the CLI it's run from, or other programs, such as XOpa,
  4769. ; or Executive's Commander.
  4770.  
  4771. ; Put it into all loops you want to break.
  4772.  
  4773. Function ReceiveCtrlC {}
  4774.   If (SetSignal_(0,#SIGBREAKF_CTRL_C) & #SIGBREAKF_CTRL_C)
  4775.     Function Return -1
  4776.   Else Function Return 0
  4777.   EndIf
  4778. End Function
  4779.  
  4780. ; demo :
  4781.  
  4782. ; FindScreen 0
  4783. ; Window 0,0,0,640,100,$140f,"Hit close gadget or send a Ctrl-C to quit...",1,2
  4784.  
  4785. ; Repeat
  4786. ;   If ReceiveCtrlC {} Then Request "","Ctrl-C received!","END":End
  4787. ;   VWait
  4788. ; Until Event=$200
  4789.  
  4790. ; End
  4791.  
  4792. ;-----------------------------------------------------------------
  4793.  
  4794. ; Function : SignalTask { taskname, signal }
  4795.  
  4796. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4797.  
  4798. ; Sends a command (eg. CTRL-C) to a program, returning -1 (True)
  4799. ; if it sent the signal (NOTE that this doesn't necessarily mean
  4800. ; the program did as it was told - not all programs support
  4801. ; Ctrl-C messages, etc). Returns 0 (False) if it couldn't find
  4802. ; the program.
  4803.  
  4804. ; You should note that the taskname is CASE-SENSITIVE (not my
  4805. ; choice ;) and that it can change depending on whether it
  4806. ; was run from the shell or from Workbench...and stuff...
  4807.  
  4808. ; Possible signals you can send :
  4809.  
  4810. ; #SIGBREAKF_CTRL_C (4096)  - quit    program
  4811. ; #SIGBREAKF_CTRL_D (8192)  - disable program (sleep)
  4812. ; #SIGBREAKF_CTRL_E (16384) - enable  program  (wake up)
  4813. ; #SIGBREAKF_CTRL_F (32768) - um...can't remember...
  4814.  
  4815. ; NOTE : Signals have different effects depending on the
  4816. ; receiving program's interpretation, but these are the general
  4817. ; conventions.
  4818.  
  4819. Function.b SignalTask {task$,sig.l}
  4820.  
  4821.   *task.Task=FindTask_(&task$)
  4822.  
  4823.   If *task
  4824.     Signal_ *task,sig
  4825.     Function Return -1
  4826.   Else Function Return 0
  4827.   EndIf
  4828.  
  4829. End Function
  4830.  
  4831. ; demo :
  4832.  
  4833. ;; NOTE : depending on your setup, your copy may have
  4834. ;; "MultiView" in different casing, eg "multiview" - adjust
  4835. ;; accordingly!
  4836.  
  4837. ; t$="MultiView"
  4838.  
  4839. ; If SignalTask{t$,#SIGBREAKF_CTRL_C}
  4840. ;   Request "","Signalled "+t$+"!","OK"
  4841. ; Else Request "","Can't find "+t$+"!","OK"
  4842. ; EndIf
  4843.  
  4844. ; End
  4845.  
  4846. ;-----------------------------------------------------------------
  4847.  
  4848. ; Statement : WaitForSignal { signal }
  4849.  
  4850. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4851.  
  4852. ; Puts your program to sleep, using 0% CPU time, until the user
  4853. ; sends the message you've asked for (eg Ctrl C).
  4854.  
  4855. ; NOTE that this can leave your user unable to continue
  4856. ; your program if they don't have a tool to send the
  4857. ; command, so best used from CLI (eg. Print "Press Ctrl-C" or
  4858. ; whatever before calling the statement), but may be useful
  4859. ; in other situations.
  4860.  
  4861. ; Run the demo and press Ctrl and C together, or send a
  4862. ; Ctrl C (BREAK) signal from a program like XOpa, ARTM,
  4863. ; Commander, etc...
  4864.  
  4865. ; Possible signals are listed below :
  4866.  
  4867. ; #SIGBREAKF_CTRL_C
  4868. ; #SIGBREAKF_CTRL_D
  4869. ; #SIGBREAKF_CTRL_E
  4870. ; #SIGBREAKF_CTRL_F
  4871.  
  4872. Statement WaitForSignal {sig.l}
  4873.   SetSignal_ 0,sig  ; clear previous occurrences (sp?!)
  4874.   Wait_ sig
  4875. End Statement
  4876.  
  4877. ; demo
  4878.  
  4879. ; WaitForSignal {#SIGBREAKF_CTRL_C}
  4880. ; End
  4881.  
  4882. ;-----------------------------------------------------------------
  4883. .
  4884. .Misc
  4885.  
  4886. ;----------------------------------------------------------------
  4887.  
  4888. ; These routines didn't really fit anywhere else.
  4889. ; A lot of them deal with information about the currently
  4890. ; running program (ie your program!) though.
  4891.  
  4892. ;-----------------------------------------------------------------
  4893.  
  4894. ; Current routines :
  4895.  
  4896. ; ProgsDir        {}
  4897. ; ProgsName       {}
  4898. ; SetPriority     { priority }
  4899. ; Language        {}
  4900. ; StupidRequest   { title, body text }
  4901.  
  4902. ;-----------------------------------------------------------------
  4903.  
  4904. ; Function : ProgsDir {}
  4905.  
  4906. ; Author : Nick Clover - nick@bauk.freeserve.co.uk
  4907.  
  4908. ; Returns a string with the program's directory.
  4909.  
  4910. ; IMPORTANT! Only works with compiled executables,as
  4911. ; Compiling & Running doesn't use a directory (obviously ;)
  4912.  
  4913. ; **** REPLACEMENT by Nick Clover ****
  4914. ; Now returns program directory when run from WB as well!
  4915. ; Cool :)
  4916.  
  4917. ; UPDATE - renamed to ProgsDir, to keep in line with ProgsName,
  4918. ;          because ProgDir is a Blitz Support Suite command.
  4919.  
  4920. Function.s ProgsDir{}
  4921.  
  4922.   MaxLen path$=200
  4923.   NameFromLock_ GetProgramDir_(),&path$,200
  4924.   path$=Peek$(&path$)
  4925.   If Right$(path$,1)<>":" AND Right$(path$,1)<>"/"
  4926.     path$+"/"
  4927.   EndIf
  4928.   If path$="SYS:" Then path$="I only work when compiled!"
  4929. Function Return path$
  4930. End Function
  4931.  
  4932. ; demo :
  4933.  
  4934. ;; note that this returns a name only from executables!
  4935. ;; you'll just get a blank string if you run it from Blitz!
  4936.  
  4937. ; Request "","Path : "+ProgsDir{},"OK"
  4938. ; End
  4939.  
  4940. ;-----------------------------------------------------------------
  4941.  
  4942. ; Function : ProgsName {}
  4943.  
  4944. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  4945.  
  4946. ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk
  4947. ; Now works when run from WB as well! Means your user can
  4948. ; rename the program if they wish and you can still find
  4949. ; your icon's tooltypes or whatever :)
  4950.  
  4951. ; UPDATED - Curt Esser reported that the name clashes
  4952. ;           with a command in the Blitz Support Suite.
  4953.  
  4954. ;           Now ProgsName instead of ProgName.
  4955.  
  4956. ; Returns a string with the program's DOS name, handy when used
  4957. ; with ProgsDir{} (eg. progpath$=ProgsDir{}+ProgsName{} )...
  4958.  
  4959. Function.s ProgsName{}
  4960.  
  4961. If FromCLI=-1
  4962.  
  4963.   *stringbuffer = AllocMem_(255, 0)
  4964.   suc.l=GetProgramName_(*stringbuffer,255)
  4965.  
  4966.   If suc
  4967.     pname$=Peek$(*stringbuffer)
  4968.   EndIf
  4969.  
  4970.   FreeMem_ *stringbuffer,255
  4971.  
  4972. Else pname$=Peek$(Peek.l(FindTask_(0)+$B0)+4)
  4973. EndIf
  4974.  
  4975. If pname$="" Then pname$="I only work when compiled!"
  4976.  
  4977. Function Return pname$
  4978.  
  4979. End Function
  4980.  
  4981. ; demo :
  4982.  
  4983. ;; note that this returns a name only from executables!
  4984.  
  4985. ; a$=ProgsName{}
  4986. ; Request "","Program name : "+a$,"OK"
  4987. ; End
  4988.  
  4989. ;-----------------------------------------------------------------
  4990.  
  4991. ; Function : SetPriority { priority }
  4992.  
  4993. ; Author : Peter Thor - email?
  4994. ;          priority check added by JLB
  4995.  
  4996. ; Sets the priority of your program to whatever you want.
  4997. ; Negative numbers mean higher priority (roughly : more CPU
  4998. ; time). Priority can be from -127 to +127. Positive numbers
  4999. ; mean higher priority. It's recommended that most programs
  5000. ; shouldn't use higher than 5-10 as far as I remember, but
  5001. ; as long as you know what you're doing, you can crank it
  5002. ; up to whatever you want (up to 127!), or make it low if
  5003. ; it doesn't need much CPU time).
  5004.  
  5005. ; Returns value of priority before function was called, so
  5006. ; you just call SetPriority {returned value} to put it
  5007. ; back how it was.
  5008.  
  5009. ; Couldn't really decide how to return a failure, so just
  5010. ; returns 0, which is still a valid value! Adjust it to suit
  5011. ; your needs!
  5012.  
  5013. Function.w SetPriority{newpriority.w}
  5014.  
  5015.   If newpriority<-127 OR newpriority>127 Then Function Return 0
  5016.  
  5017.   Forbid_                     ;lock system to check for task
  5018.  
  5019.   *task.l=FindTask_(*crap.l)  ;*crap.l is only a NULL-Pointer
  5020.                               ;this way the task of the program itself
  5021.                               ;is returned
  5022.  
  5023. ; set the new priority:
  5024.   oldpriority.w=SetTaskPri_(*task,newpriority.w)
  5025.  
  5026.   Permit_                     ;and return the system
  5027.  
  5028. Function Return oldpriority.w
  5029.  
  5030. End Function
  5031.  
  5032. ; demo :
  5033.  
  5034. ;; NOTE : Use XOpa or similar program to see priority. If you're
  5035. ;; running from Blitz, it'll be the "Blitz ][ Program Proc" you're
  5036. ;; looking for. With most of these type of programs, you'll have
  5037. ;; to update the task list to see the change.
  5038.  
  5039. ;; I use Executive, which I think modifies the priority you
  5040. ;; set, so I sometimes get some weird number listed, but it
  5041. ;; basically works!
  5042.  
  5043. ; Repeat
  5044.  
  5045. ;   Print "Priority (-127 to 127), 1000 to end : "
  5046. ;   a.w=Edit(4)
  5047. ;   If a=1000 Then End
  5048.  
  5049. ;   oldpri.w=SetPriority {a}
  5050. ;   NPrint "The old priority was : ",oldpri
  5051. ;   NPrint ""
  5052.  
  5053. ; Forever
  5054.  
  5055. ;-----------------------------------------------------------------
  5056.  
  5057. ; Function - Language {}
  5058.  
  5059. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  5060.  
  5061. ; Returns a string containing the user's default
  5062. ; language as set in their Locale preferences.
  5063.  
  5064. ; Should still work (well, fail safely!) on <OS2.0
  5065. ; because it checks for the locale.library before
  5066. ; calling OpenLocale_ (). Mail me if you've tried it!
  5067.  
  5068. ; Useful for custom locale setups, eg. ascii files
  5069. ; full of strings for each language. If the file for
  5070. ; the language returned by this function exists, use
  5071. ; it, and if not (or if you get an empty ("") string
  5072. ; returned), just give your user a default language.
  5073.  
  5074. ; Saves the hassle of proper locale setups, and
  5075. ; should work just as well ;)
  5076.  
  5077. Function$ Language {}
  5078.  
  5079.   l$="locale.library"
  5080.   *loclib=OpenLibrary_ (&l$,0)
  5081.  
  5082.   If *loclib
  5083.  
  5084.     *locale.Locale=OpenLocale_(0)
  5085.  
  5086.     If *locale
  5087.       country$=Peek$(*locale\loc_LanguageName)
  5088.       CloseLocale_ *locale
  5089.     EndIf
  5090.  
  5091.   CloseLibrary_ *loclib
  5092.   EndIf
  5093.  
  5094.   If country$
  5095.     country$=Left$(country$,Len(country$)-9)
  5096.   EndIf
  5097.  
  5098. Function Return country$
  5099. End Function
  5100.  
  5101. ; demo :
  5102.  
  5103. ; NPrint ""
  5104.  
  5105. ; a$=Language {}
  5106.  
  5107. ; If a$
  5108. ;   NPrint "User's Workbench uses ",a$," locale."
  5109. ; Else NPrint "Can't find locale settings, using english!"
  5110. ; EndIf
  5111.  
  5112. ; MouseWait:End
  5113.  
  5114. ;-----------------------------------------------------------------
  5115.  
  5116. ; Statement : StupidRequest { title, body text }
  5117.  
  5118. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  5119.  
  5120. ; This statement is probably useless for most people, but
  5121. ; we used it in BeatBox2 to generate 'amusing' error requesters
  5122. ; when people make mistakes - you supply the title and error text,
  5123. ; and this just adds an incredibly, side-splittingly funny
  5124. ; gadget (maybe not... ;)
  5125.  
  5126. ; You can easily replace all the strings, but make sure you
  5127. ; adjust the number of strings used in the first Data
  5128. ; statement.
  5129.  
  5130. ; As I said, nothing special, but it's just a little idea
  5131. ; to make things (slightly) more interesting by making things
  5132. ; a little random...
  5133.  
  5134. Statement StupidRequest {title$,body$}
  5135.  
  5136.   Restore stupidstrings
  5137.   Read t
  5138.   r=Int(Rnd*t)+1
  5139.   For a=1 To r
  5140.     Read stupid$
  5141.   Next a
  5142.  
  5143. If body$="" OR stupid$="" Then Statement Return
  5144.  
  5145. Request title$,body$,stupid$
  5146.  
  5147. Statement Return
  5148.  
  5149. stupidstrings:
  5150.  
  5151. Data 26 ; number of strings - ADJUST if you add/remove strings!
  5152.  
  5153. Data$ "Doh!","Oh,OK...","It's a wonder I'm still breathing!","Gotcha!","I see...","Hmm...makes sense!","Oh,great!"
  5154. Data$ "Oh,yeah...","Ahh!","Oh,I get it now!","It's all so obvious now!","Oh,right...","Sorry,I'm stupid!","You lousy *#@$!"
  5155. Data$ "I'm learning!","Ooh...","AAARRRGGGHHHHH!!!","Grrr...","Where's the 'Any' key?","I'm lost...","'Easy' indeed..."
  5156. Data$ "My other computer's a PC!","NOOOOoooooo.....","Just testing!","I should be using Windows...","I'm a Mac user..."
  5157.  
  5158. End Statement
  5159.  
  5160. ; demo :
  5161.  
  5162. ; StupidRequest{"My Program","You've made a big mistake!"}
  5163.  
  5164. ; End
  5165.  
  5166. ;-----------------------------------------------------------------
  5167.  
  5168. Request "statements&functions.bb2","You can't just run this!","Oh..."
  5169. End    ; just in case ;)
  5170.  
  5171.